From 2b321515edb2128a1eb05e3b633924e72093dc49 Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 24 Oct 2013 16:54:03 -0200 Subject: [PATCH 001/294] removendo isOpen --- Forms/osCustomEditFrm.pas | 10 ---------- Forms/osCustomMainFrm.pas | 3 +-- 2 files changed, 1 insertion(+), 12 deletions(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 0f06607..92462b1 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -64,7 +64,6 @@ TosCustomEditForm = class(TosForm) procedure FormCreate(Sender: TObject); procedure PararButtonClick(Sender: TObject); procedure MasterDataSourceDataChange(Sender: TObject; Field: TField); - procedure FormClose(Sender: TObject; var Action: TCloseAction); private FDatamodule: TDatamodule; FInitialControl: TWinControl; @@ -79,7 +78,6 @@ TosCustomEditForm = class(TosForm) FFormMode: TFormMode; FExternalCDS: TosClientDataset; FIsModified: boolean; - FIsOpen: Boolean; procedure MasterDatasetAfterEdit(DataSet: TDataSet); virtual; procedure CheckMasterDataset; procedure Loaded; override; @@ -101,7 +99,6 @@ TosCustomEditForm = class(TosForm) property IsModified: boolean read FIsModified; property Datamodule: TDatamodule read FDatamodule write SetDatamodule; property VisibleButtons: TVisibleButtons read FVisibleButtons write FVisibleButtons; - property IsOpen: Boolean read FIsOpen write FIsOpen; function canInsert: boolean; virtual; end; @@ -524,13 +521,6 @@ procedure TosCustomEditForm.MasterDataSourceDataChange(Sender: TObject; CancelUpdatesAction.Enabled := true; end; -procedure TosCustomEditForm.FormClose(Sender: TObject; - var Action: TCloseAction); -begin - inherited; - IsOpen := False; -end; - end. diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 945e5a9..a00a57b 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -363,9 +363,8 @@ procedure TosCustomMainForm.EditActionExecute(Sender: TObject); Form := FCurrentEditForm; if Assigned(Form) then begin - if not Form.IsOpen then + if not Form.Showing then begin - Form.IsOpen := True; iID := FIDField.AsInteger; Form.VisibleButtons := [vbSalvarFechar, vbFechar]; if PrintAction.Enabled then From 332086686903fa55d1aefc98ae277b42b49f5ffa Mon Sep 17 00:00:00 2001 From: hotsoft-desenv4 Date: Tue, 5 Nov 2013 14:20:01 -0200 Subject: [PATCH 002/294] removendo comentarios --- Forms/osCustomMainFrm.dfm | 14 +++------ Forms/osCustomMainFrm.pas | 64 +-------------------------------------- 2 files changed, 6 insertions(+), 72 deletions(-) diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index 52ce06b..ea3e235 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -25,7 +25,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 14 Top = 2 Width = 262 - Height = 22 + Height = 29 AutoSize = True ButtonHeight = 29 ButtonWidth = 29 @@ -720,7 +720,6 @@ inherited osCustomMainForm: TosCustomMainForm ShowRoot = False StateImages = BarSmallImages TabOrder = 4 - OnAdvancedCustomDrawItem = TreeView1AdvancedCustomDrawItem OnChange = TreeView1Change end inherited ActionList: TosActionList @@ -874,9 +873,6 @@ inherited osCustomMainForm: TosCustomMainForm object Imprimir: TMenuItem Action = PrintAction end - object ImprimirFiltro: TMenuItem - Action = PrintFilterAction - end object N2: TMenuItem Caption = '-' end @@ -983,7 +979,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 4 Top = 96 Bitmap = { - 494C010101000400380020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101010004003C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000800000002000000001002000000000000040 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000CECEBD00C6C6BD00C6BDB500C6BDB500C6BD @@ -1522,7 +1518,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 36 Top = 96 Bitmap = { - 494C010101000400380010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101010004003C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -1693,7 +1689,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 144 Top = 240 Bitmap = { - 494C010102000400380010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101020004003C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2099,7 +2095,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 674 Top = 52 Bitmap = { - 494C01010A000E00380016001600FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01010A000E003C0016001600FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000058000000420000000100200000000000C05A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 45914de..21af22c 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -16,7 +16,7 @@ interface ppModule, daDataModule, FMTBcd, osCustomDataSetProvider, osSQLDataSetProvider, daSQl, daQueryDataView, ppTypes, acCustomReportUn, osSQLQuery, acFilterController, CommCtrl, clipbrd, osCustomLoginFormUn, - acReportContainer, ppParameter, Data.DBXInterBase, System.Actions;//ppWWRichEd; + acReportContainer, ppParameter, Data.DBXInterBase, System.Actions; type TDatamoduleClass = class of TDatamodule; @@ -54,7 +54,6 @@ TosCustomMainForm = class(TosForm) N1: TMenuItem; Visualizar1: TMenuItem; Imprimir1: TMenuItem; - ImprimirFiltro: TMenuItem; N2: TMenuItem; ShowQueryAction: TAction; MostrarQuery: TMenuItem; @@ -188,9 +187,6 @@ TosCustomMainForm = class(TosForm) procedure EfetuarBackupemarquivolocal1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TreeView1Change(Sender: TObject; Node: TTreeNode); - procedure TreeView1AdvancedCustomDrawItem(Sender: TCustomTreeView; - Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; - var PaintImages, DefaultDraw: Boolean); procedure GridCalcCellColors(Sender: TObject; Field: TField; State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush); @@ -233,7 +229,6 @@ TosCustomMainForm = class(TosForm) procedure checkOperations; procedure adjustReportZoom; - procedure SetNodeState(node: TTreeNode; Flags: Integer); protected FCurrentTemplate: TMemoryStream; FCurrentResource: TosAppResource; @@ -341,12 +336,6 @@ constructor TosCustomMainForm.Create(AOwner: TComponent); qry.SQL.Text := 'SELECT NAME FROM XFILTERDEF'; qry.Open; qry.First; - //while not qry.Eof do - //begin - //vViews := FilterDataset.DataRequest('_CMD=GET_VIEWS UID= CLASSNAME=' + qry.FieldByName('NAME').AsString); - //FFilterDepot.addFilter(qry.FieldByName('NAME').AsString, vViews); - //qry.Next; - //end; finally FreeAndNil(qry); acCustomSQLMainData.FilterQuery.SQLConnection := acCustomSQLMainData.SQLConnection; @@ -619,31 +608,6 @@ function TosCustomMainForm.GetSelectedList: TStringList; EnableControls; { Re-enable controls } end; - - - { - - FSelectedList.Clear; - if Grid.SelectedRows.Count > 0 then - begin - with FilterDataset do - begin - bm := FilterDataset.GetBookmark; - try - DisableControls; - for i:=0 to Grid.SelectedRows.Count-1 do - begin - GotoBookmark(pointer(Grid.SelectedRows.Items[i])); - FSelectedList.Add(FIDField.AsString); - end; - finally - GotoBookmark(bm); - FreeBookmark(bm); - EnableControls; - end; - end; - end; - } Result := FSelectedList; end; @@ -1275,7 +1239,6 @@ procedure TosCustomMainForm.LoadTreeView; no := TreeView1.Items.AddChild(noPai, name); no.ImageIndex := ImageIndex; no.SelectedIndex := Manager.Resources[i].ID; - SetNodeState(no, TVIS_BOLD) end; end; end; @@ -1689,31 +1652,6 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; PrintAction.Enabled := (FCurrentResource.ReportClassName <> ''); end; -procedure TosCustomMainForm.SetNodeState(node: TTreeNode; Flags: Integer); -var tvi: TTVItemEx; -begin -{ FillChar(tvi, SizeOf(tvi), 0); - tvi.hItem := node.ItemID; - tvi.Mask := TVIF_STATE; - tvi.StateMask := TVIS_BOLD or TVIS_CUT; - tvi.State := Flags; - TreeView_SetItemA(node.Handle, tvi); -{ if node.Text = 'Orçamento' then - TreeView_SetItemHeight(node.Handle, 30) - else - TreeView_SetItemHeight(node.Handle, 15);} -end; - - -procedure TosCustomMainForm.TreeView1AdvancedCustomDrawItem( - Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; - Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean); -begin - inherited; - // TODO: ver depois - // Node.DisplayRect(true).Height := 10; -end; - procedure TosCustomMainForm.GridCalcCellColors(Sender: TObject; Field: TField; State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush); From 70944305425e12fac41293b20bc1f97d21b96904 Mon Sep 17 00:00:00 2001 From: hotsoft-desenv4 Date: Thu, 7 Nov 2013 08:25:14 -0200 Subject: [PATCH 003/294] saida dos diretorios --- package/fw.cfg | 6 +++--- package/fw.dof | 19 ++++++++++++++----- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/package/fw.cfg b/package/fw.cfg index c86eba8..57997e9 100644 --- a/package/fw.cfg +++ b/package/fw.cfg @@ -31,9 +31,9 @@ -M -$M16384,1048576 -K$00400000 --N"../Temp" --LE"D:\svn\delphi\bin" --LN"D:\svn\delphi\bin" +-N"../dcu_7" +-LE"C:\delphi\bin" +-LN"C:\delphi\bin" -Z -w-UNSAFE_TYPE -w-UNSAFE_CODE diff --git a/package/fw.dof b/package/fw.dof index 6a564ae..a5b9603 100644 --- a/package/fw.dof +++ b/package/fw.dof @@ -91,7 +91,7 @@ ImageBase=4194304 ExeDescription= [Directories] OutputDir= -UnitOutputDir=../Temp +UnitOutputDir=../dcu_7 PackageDLLOutputDir= PackageDCPOutputDir= SearchPath= @@ -112,9 +112,9 @@ RootDir= [Version Info] IncludeVerInfo=1 AutoIncBuild=0 -MajorVer=2 -MinorVer=6 -Release=137 +MajorVer=1 +MinorVer=0 +Release=0 Build=0 Debug=0 PreRelease=0 @@ -126,7 +126,7 @@ CodePage=1252 [Version Info Keys] CompanyName= FileDescription= -FileVersion=2.6.137.0 +FileVersion=1.0.0.0 InternalName= LegalCopyright= LegalTrademarks= @@ -134,3 +134,12 @@ OriginalFilename= ProductName= ProductVersion=1.0.0.0 Comments= +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlUnitOutputDirectory] +Count=4 +Item0=../dcu_7 +Item1=../../Temp +Item2=../Temp +Item3=C:\lib\dunit\dunit-9.3.0\dcu_7 From 79c2ca402b23e9aba26d8347042e43c9db7801a1 Mon Sep 17 00:00:00 2001 From: hotsoft-desenv4 Date: Mon, 11 Nov 2013 08:49:46 -0200 Subject: [PATCH 004/294] =?UTF-8?q?removendo=20evento=20desnecess=C3=A1rio?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.dfm | 2 +- Datamodules/osLookupDataUn.dfm | 2 +- Forms/osCustomEditFrm.dfm | 3 +-- Forms/osFrm.dfm | 2 +- 4 files changed, 4 insertions(+), 5 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.dfm b/Datamodules/acCustomSQLMainDataUn.dfm index a8ddeb3..e9fb6f9 100644 --- a/Datamodules/acCustomSQLMainDataUn.dfm +++ b/Datamodules/acCustomSQLMainDataUn.dfm @@ -1,7 +1,7 @@ object acCustomSQLMainData: TacCustomSQLMainData OldCreateOrder = False OnCreate = DataModuleCreate - Left = 552 + Left = 589 Top = 132 Height = 365 Width = 631 diff --git a/Datamodules/osLookupDataUn.dfm b/Datamodules/osLookupDataUn.dfm index f4b4fc7..c74de79 100644 --- a/Datamodules/osLookupDataUn.dfm +++ b/Datamodules/osLookupDataUn.dfm @@ -1,6 +1,6 @@ object osLookupData: TosLookupData OldCreateOrder = False - Left = 327 + Left = 349 Top = 414 Height = 150 Width = 215 diff --git a/Forms/osCustomEditFrm.dfm b/Forms/osCustomEditFrm.dfm index 13794db..417b847 100644 --- a/Forms/osCustomEditFrm.dfm +++ b/Forms/osCustomEditFrm.dfm @@ -1,12 +1,11 @@ inherited osCustomEditForm: TosCustomEditForm - Left = 40 + Left = 43 Top = 351 Width = 502 Height = 335 Caption = 'osCustomEditForm' Menu = MainMenu OldCreateOrder = True - OnClose = FormClose OnCloseQuery = FormCloseQuery PixelsPerInch = 96 TextHeight = 13 diff --git a/Forms/osFrm.dfm b/Forms/osFrm.dfm index 6142501..e9af46b 100644 --- a/Forms/osFrm.dfm +++ b/Forms/osFrm.dfm @@ -1,5 +1,5 @@ object osForm: TosForm - Left = 259 + Left = 276 Top = 277 Width = 401 Height = 278 From 4657bd6d95f64d8607de55252023c929711d258d Mon Sep 17 00:00:00 2001 From: hotsoft-desenv4 Date: Tue, 26 Nov 2013 15:48:18 -0200 Subject: [PATCH 005/294] =?UTF-8?q?fun=C3=A7=C3=A3o=20de=20convers=C3=A3o?= =?UTF-8?q?=20de=20datas?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2a1bd37..06d33fe 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -60,6 +60,7 @@ function GetNewID(conn: TosSQLConnection): Integer; function GetGenerator(conn: TosSQLConnection; generator: string): Integer; function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; +function ConverteStrToDate3(data: string): TDateTime; function GetIPAddress: string; implementation @@ -876,6 +877,13 @@ function ConverteStrToDate2(data: string): TDateTime; Copy(FormatDateTime('yyyy',Today),1,2)+Copy(data,7,2)); end; +//010120131015 => 01/01/2013 10:15 +function ConverteStrToDate3(data: string): TDateTime; +begin + Result := StrToDateTime(Copy(data,1,2)+'/'+Copy(data,3,2)+'/20'+Copy(data,5,2)+' '+ + Copy(data,7,2)+':'+Copy(data,9,2)); +end; + function GetIPAddress: string; var Buffer: array[0..255] of Char; From 96c118b3f8fe647dc2c3cd925d8373e3fc2d6208 Mon Sep 17 00:00:00 2001 From: hotsoft-desenv4 Date: Thu, 12 Dec 2013 10:33:29 -0200 Subject: [PATCH 006/294] Bloqueando o Ctrl+Tab dos wizzards. --- Forms/osWizFrm.dfm | 1 + Forms/osWizFrm.pas | 12 ++++++++++++ 2 files changed, 13 insertions(+) diff --git a/Forms/osWizFrm.dfm b/Forms/osWizFrm.dfm index c47c08e..3485149 100644 --- a/Forms/osWizFrm.dfm +++ b/Forms/osWizFrm.dfm @@ -37,6 +37,7 @@ object osWizForm: TosWizForm Style = tsFlatButtons TabHeight = 1 TabOrder = 1 + OnChanging = pgcWizardChanging object TabSheet1: TTabSheet Caption = 'TabSheet1' DesignSize = ( diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index 89850b5..9cd0901 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -31,10 +31,12 @@ TosWizForm = class(TosForm) procedure btnAvancarClick(Sender: TObject); procedure btnCancelarClick(Sender: TObject); procedure FormShow(Sender: TObject); + procedure pgcWizardChanging(Sender: TObject; var AllowChange: Boolean); private FShowLogPage: boolean; FMovingForward: boolean; FCompleteAction: boolean; + FMudarTela: Boolean; function GetIndexLastPage: integer; protected procedure UpdatePage; virtual; @@ -88,6 +90,7 @@ procedure TosWizForm.UpdatePage; procedure TosWizForm.btnVoltarClick(Sender: TObject); begin inherited; + FMudarTela := True; CompleteAction := True; FMovingForward := False; OnLeavePage.Execute; @@ -98,6 +101,7 @@ procedure TosWizForm.btnVoltarClick(Sender: TObject); procedure TosWizForm.btnAvancarClick(Sender: TObject); begin inherited; + FMudarTela := True; CompleteAction := True; FMovingForward := True; OnLeavePage.Execute; @@ -210,6 +214,7 @@ function TosWizForm.GetIndexLastPage: integer; procedure TosWizForm.FormShow(Sender: TObject); begin + FMudarTela := False; ShowLogPage := True; btnAvancar.Enabled := True; btnCancelar.Caption := constCancelarCaption; @@ -234,5 +239,12 @@ procedure TosWizForm.Log(const PMessage: string; Application.ProcessMessages; end; +procedure TosWizForm.pgcWizardChanging(Sender: TObject; var AllowChange: Boolean); +begin + if not FMudarTela then + AllowChange := False; + FMudarTela := False; +end; + end. From a7932e95ac497a7862fd96a156258037e2eef07f Mon Sep 17 00:00:00 2001 From: hotsoft-desenv5 Date: Thu, 12 Dec 2013 12:00:43 -0200 Subject: [PATCH 007/294] =?UTF-8?q?Erro=20permiss=C3=A3o=20de=20grupo=20de?= =?UTF-8?q?=20usu=C3=A1rio?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomMainFrm.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index a00a57b..c0d1e15 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1543,6 +1543,7 @@ procedure TosCustomMainForm.checkOperations; begin NewAction.Enabled := NewAction.Enabled AND (oInserir in osForm.Operacoes); EditAction.Enabled := EditAction.Enabled AND (oEditar in osForm.Operacoes); + EditarTodosButton.Enabled := EditAction.Enabled; DeleteAction.Enabled := DeleteAction.Enabled AND (oExcluir in osForm.Operacoes); ViewAction.Enabled := ViewAction.Enabled AND (oVisualizar in osForm.Operacoes); PrintAction.Enabled := PrintAction.Enabled AND ((oImprimir in osForm.Operacoes) or ((FCurrentResource.ReportClassName <> ''))); @@ -1553,6 +1554,7 @@ procedure TosCustomMainForm.ControlActions(enabled: boolean); begin NewAction.Enabled := enabled; EditAction.Enabled := enabled; + EditarTodosButton.Enabled := enabled; DeleteAction.Enabled := enabled; ViewAction.Enabled := enabled; PrintAction.Enabled := enabled; From 29419d8b65fe2bbb58576a5cbc7dc5f368691a44 Mon Sep 17 00:00:00 2001 From: Juliano Date: Tue, 4 Feb 2014 14:44:18 -0200 Subject: [PATCH 008/294] gitignore --- .gitignore | 7 ++ package/fw.dof | 136 --------------------- package/fw.dpk | 3 +- package/fw.dproj | 268 +++++++++++++++++++++++++++++++++++++++++ package/fw.dproj.local | 2 + package/fw_Icon.ico | Bin 0 -> 766 bytes 6 files changed, 279 insertions(+), 137 deletions(-) create mode 100644 .gitignore delete mode 100644 package/fw.dof create mode 100644 package/fw.dproj create mode 100644 package/fw.dproj.local create mode 100644 package/fw_Icon.ico diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b0ab88c --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +/package/fw.dof +/dcu_7/*.dcu + +/Forms/*.ddp +/Datamodules/*.ddp +/package/*.identcache +/package/*.otares diff --git a/package/fw.dof b/package/fw.dof deleted file mode 100644 index 6a564ae..0000000 --- a/package/fw.dof +++ /dev/null @@ -1,136 +0,0 @@ -[FileVersion] -Version=7.0 -[Compiler] -A=8 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=0 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -NamespacePrefix= -SymbolDeprecated=1 -SymbolLibrary=1 -SymbolPlatform=1 -UnitLibrary=1 -UnitPlatform=1 -UnitDeprecated=1 -HResultCompat=1 -HidingMember=1 -HiddenVirtual=1 -Garbage=1 -BoundsError=1 -ZeroNilCompat=1 -StringConstTruncated=1 -ForLoopVarVarPar=1 -TypedConstVarPar=1 -AsgToTypedConst=1 -CaseLabelRange=1 -ForVariable=1 -ConstructingAbstract=1 -ComparisonFalse=1 -ComparisonTrue=1 -ComparingSignedUnsigned=1 -CombiningSignedUnsigned=1 -UnsupportedConstruct=1 -FileOpen=1 -FileOpenUnitSrc=1 -BadGlobalSymbol=1 -DuplicateConstructorDestructor=1 -InvalidDirective=1 -PackageNoLink=1 -PackageThreadVar=1 -ImplicitImport=1 -HPPEMITIgnored=1 -NoRetVal=1 -UseBeforeDef=1 -ForLoopVarUndef=1 -UnitNameMismatch=1 -NoCFGFileFound=1 -MessageDirective=1 -ImplicitVariants=1 -UnicodeToLocale=1 -LocaleToUnicode=1 -ImagebaseMultiple=1 -SuspiciousTypecast=1 -PrivatePropAccessor=1 -UnsafeType=0 -UnsafeCode=0 -UnsafeCast=0 -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir= -UnitOutputDir=../Temp -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages= -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -Launcher= -UseLauncher=0 -DebugCWD= -[Language] -ActiveLang= -ProjectLang= -RootDir= -[Version Info] -IncludeVerInfo=1 -AutoIncBuild=0 -MajorVer=2 -MinorVer=6 -Release=137 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1046 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=2.6.137.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= diff --git a/package/fw.dpk b/package/fw.dpk index 5b30878..182bb0f 100644 --- a/package/fw.dpk +++ b/package/fw.dpk @@ -1,6 +1,7 @@ package fw; {$R *.res} +{$R *.otares} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} @@ -15,7 +16,7 @@ package fw; {$OPTIMIZATION OFF} {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} -{$REFERENCEINFO ON} +{$DEFINITIONINFO ON} {$SAFEDIVIDE OFF} {$STACKFRAMES ON} {$TYPEDADDRESS OFF} diff --git a/package/fw.dproj b/package/fw.dproj new file mode 100644 index 0000000..b30728f --- /dev/null +++ b/package/fw.dproj @@ -0,0 +1,268 @@ + + + {3D5FE4EA-7EBF-44F6-B86B-69679EDA1E04} + fw.dpk + True + Debug + 1 + Package + VCL + 14.6 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + 2 + false + CompanyName=;FileDescription=;FileVersion=2.6.137.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 6 + 1046 + false + true + true + 1 + false + 137 + true + false + ../Temp + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;Bde;Datasnap.Win;Data.Win;$(DCC_Namespace) + 00400000 + true + true + + + 1033 + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + fw_Icon.ico + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + + + fw_Icon.ico + + + false + 0 + RELEASE;$(DCC_Define) + false + + + true + false + DEBUG;$(DCC_Define) + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
osForm
+ + + + + +
osErrorHandlerForm
+ + + + + + + + + + + + +
osLookupData
+ TDataModule + + +
acCustomSQLMainData
+ TDataModule + + +
osCustomEditForm
+ + +
osWizForm
+ + +
osCustomMainForm
+ + +
FilterDefData
+ TDataModule + + +
acCustomParametroSistemaData
+ TDataModule + + +
acCustomRelatorioData
+ TDataModule + + + +
FilterDefEditForm
+ + + +
AdministracaoLookupData
+ TDataModule + + +
RecursoData
+ TDataModule + + +
RelatorioLookupData
+ TDataModule + + +
EscolhaConexaoForm
+ + +
TradutorForm
+ + +
ImprimirRelatorioForm
+ + +
acCustomReport
+ TDataModule + + + +
LoginForm
+ + + +
ShowEventoLogForm
+ + + +
RecursoEditForm
+ + +
ImprimirRelatorioTesteForm
+ + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + fw.dpk + + + True + False + 2 + 6 + 137 + 0 + False + False + False + False + False + 1046 + 1252 + + + + + 2.6.137.0 + + + + + + 1.0.0.0 + + + + + False + False + True + False + + + 12 + + + + diff --git a/package/fw.dproj.local b/package/fw.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/package/fw.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/package/fw_Icon.ico b/package/fw_Icon.ico new file mode 100644 index 0000000000000000000000000000000000000000..cfd8992a5b8ff4b89478d89e93ae9205bb8125ef GIT binary patch literal 766 zcmZvaJxjw-6o%h^fPsh~i*;)WQr#qE6x5;U{}5?bDU!Qs#KAy@{*{(2!dc?v-w<3J zyH!xUzUL;X9X!dK+~<6Tdjqt14F+APeYAl+zK^H@bxyTV#lYDAmIAzyrqzp2E~yk{ zSu$YV4Qq8p@lqEbez>c)L$@gg8}<%Oa6GG-Tha@RIgpyYyx3_6 z0sK0F9J)}Gz=q1c)CrmBhWa9M&IR0YL{dad6xMSUMJ!a-f}CrS zObTrz@|^QLXnD=E3VB8v_nQw=P@5rbS=*@WSgTre9_?ZacCm^3g@?0G70_3Gujz+t p>P*GoN!7Oxk5il4S6hB}YQS~ZBQNRfhwsN>Ye}J@)z3c!&m?S literal 0 HcmV?d00001 From 335375acfb644fc10314db680a1947f3b62a1bf5 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 3 Mar 2014 15:09:42 -0300 Subject: [PATCH 009/294] =?UTF-8?q?mudan=C3=A7a=20de=20messagebox?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osWizFrm.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index fc21131..f7bc443 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -141,7 +141,7 @@ procedure TosWizForm.btnCancelarClick(Sender: TObject); ModalResult := mrOK; Close; end - else if Application.MessageBox(PChar('Cancelar o ' + Caption + '?') , 'Cancelar', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then + else if MessageDlg(PChar('Cancelar o ' + Caption + '?'), mtConfirmation, mbYesNo, 0) = mrYes then begin ModalResult := mrCancel; Close; From 69833910dd7414a9945ace9f3a4e9190b6600092 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 17 Mar 2014 16:59:29 -0300 Subject: [PATCH 010/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20nas=20f=C3=B3mulas?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 24 ++++++++++++------------ Lib/osMaquina.pas | 12 ++++++------ 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index 700056a..693e2ce 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -66,14 +66,14 @@ function sub(Parametros: TList): string; valor, antigo, novo: String; dvalor: Double; begin - valor := PChar(Parametros.Items[2]); + valor := PAnsiChar(Parametros.Items[2]); if valor = '' then begin dvalor := Double(Parametros.Items[2]^); valor := FloatToStr(dvalor); end; - antigo := PChar(Parametros.Items[1]); - novo := PChar(Parametros.Items[0]); + antigo := PAnsiChar(Parametros.Items[1]); + novo := PAnsiChar(Parametros.Items[0]); Result := StringReplace(valor,antigo,novo,[rfReplaceAll, rfIgnoreCase]); end; @@ -83,9 +83,9 @@ function sif(Parametros: TList): string; begin ExpLogica := Double(Parametros.Items[2]^); if ExpLogica <> 1 then - Result := PChar(Parametros.Items[0]) + Result := PAnsiChar(Parametros.Items[0]) else - Result := PChar(Parametros.Items[1]); + Result := PAnsiChar(Parametros.Items[1]); end; function sel(Parametros: TList): string; @@ -93,7 +93,7 @@ function sel(Parametros: TList): string; valor: String; inicio, qtde: Integer; begin - valor := PChar(Parametros.Items[2]); + valor := PAnsiChar(Parametros.Items[2]); inicio := trunc(Double(Parametros.Items[1]^)); qtde := trunc(Double(Parametros.Items[0]^)); Result := Copy(valor, inicio, qtde); @@ -102,7 +102,7 @@ function sel(Parametros: TList): string; function num(Parametros: TList): Double; begin try - Result := StrToFloat(PChar(Parametros.Items[0])); + Result := StrToFloat(PAnsiChar(Parametros.Items[0])); except Result := 0; end; @@ -112,8 +112,8 @@ function concat(Parametros: TList): string; var v1,v2: string; begin - v1 := PChar(Parametros.Items[1]); - v2 := PChar(Parametros.Items[0]); + v1 := PAnsiChar(Parametros.Items[1]); + v2 := PAnsiChar(Parametros.Items[0]); Result := v1 + v2; end; @@ -129,12 +129,12 @@ function round(Parametros: TList): Double; function masc(Parametros: TList): string; begin - Result := FormatFloat(PChar(Parametros.Items[1]), Double(Parametros.Items[0]^)); + Result := FormatFloat(PAnsiChar(Parametros.Items[1]), Double(Parametros.Items[0]^)); end; function equal(Parametros: TList): Double; begin - if (string(PChar(Parametros.Items[1])) = string(PChar(Parametros.Items[0]))) then + if (PAnsiChar(Parametros.Items[1]) = (PAnsiChar(Parametros.Items[0]))) then Result := 1 else Result := 2; @@ -142,7 +142,7 @@ function equal(Parametros: TList): Double; function trimstr(Parametros: TList): string; begin - Result := Trim(PChar(Parametros.Items[0])); + Result := Trim(PAnsiChar(Parametros.Items[0])); end; end. diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index bbbc87d..5e406e6 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -58,7 +58,7 @@ TosMaquina = class FVariaveis: TListLookUp; // Listas de variaveis e funcoes definidas FFuncoes: TListLookUp; FResultado: Double; // Resultado do processamento - FResultadoStr: string; // Resultado do processamento + FResultadoStr: String; // Resultado do processamento FnLinhaProc: Integer; // Linha atual sendo processada FnNumArg: Integer; // Linha de inicio de leitura de argumento FListaErros: TListErro; // Lista de Erros ocorridos @@ -89,7 +89,7 @@ TosMaquina = class // propriedades property Resultado: Double read FResultado; - property ResultadoStr: string read FResultadoStr; + property ResultadoStr: String read FResultadoStr; property Parser: TosParser read FParser write FParser; property Variavel[NomeVar: String]: Double read LeVariavel write pSetaVariavel; property ListaVariavel: TListLookup read FVariaveis; @@ -339,7 +339,7 @@ function TosMaquina.Exec: Boolean; procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); var ValorVar: ^Double; - ValorString: PChar; + ValorString: PAnsiChar; stringVar: string; doubleAux: Double; Variavel: TVariavelMaquina; @@ -387,7 +387,7 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); begin if FStrings = nil then FStrings := TStringList.Create; - ValorString := PChar(FStrings.Strings[ + ValorString := PAnsiChar(FStrings.Strings[ FStrings.Add(StringReplace(Parametro,'"','',[rfReplaceAll]))]); FpilhaExec.push(ValorString); end; @@ -419,7 +419,7 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); end else begin - ValorString := PChar(string(Variavel.Valor)); + ValorString := PAnsiChar(AnsiString(Variavel.Valor)); FpilhaExec.push(ValorString); end; end @@ -427,7 +427,7 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); begin if FStrings = nil then FStrings := TStringList.Create; - ValorString := PChar(FStrings.Strings[FStrings.Add(' ')]); + ValorString := PAnsiChar(FStrings.Strings[FStrings.Add(' ')]); FpilhaExec.push(ValorString); end; end; From af683a0274580e6a28623694259b3302782a9718 Mon Sep 17 00:00:00 2001 From: Juliano Date: Tue, 18 Mar 2014 08:03:39 -0300 Subject: [PATCH 011/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20nas=20f=C3=B3rmula?= =?UTF-8?q?s.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osMaquina.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index 5e406e6..3a50ef4 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -387,8 +387,8 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); begin if FStrings = nil then FStrings := TStringList.Create; - ValorString := PAnsiChar(FStrings.Strings[ - FStrings.Add(StringReplace(Parametro,'"','',[rfReplaceAll]))]); + ValorString := PAnsiChar(AnsiString(FStrings.Strings[ + FStrings.Add(StringReplace(Parametro,'"','',[rfReplaceAll]))])); FpilhaExec.push(ValorString); end; From 4aa707cd6b00476e9c68968bee3f509d32c2eed2 Mon Sep 17 00:00:00 2001 From: Juliano Date: Wed, 19 Mar 2014 14:03:29 -0300 Subject: [PATCH 012/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20nas=20f=C3=B3rmula?= =?UTF-8?q?s.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 24 ++++++++++++------------ Lib/osMaquina.pas | 12 ++++++------ 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index 693e2ce..a45aeca 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -66,14 +66,14 @@ function sub(Parametros: TList): string; valor, antigo, novo: String; dvalor: Double; begin - valor := PAnsiChar(Parametros.Items[2]); + valor := PChar(Parametros.Items[2]); if valor = '' then begin dvalor := Double(Parametros.Items[2]^); valor := FloatToStr(dvalor); end; - antigo := PAnsiChar(Parametros.Items[1]); - novo := PAnsiChar(Parametros.Items[0]); + antigo := PChar(Parametros.Items[1]); + novo := PChar(Parametros.Items[0]); Result := StringReplace(valor,antigo,novo,[rfReplaceAll, rfIgnoreCase]); end; @@ -83,9 +83,9 @@ function sif(Parametros: TList): string; begin ExpLogica := Double(Parametros.Items[2]^); if ExpLogica <> 1 then - Result := PAnsiChar(Parametros.Items[0]) + Result := PChar(Parametros.Items[0]) else - Result := PAnsiChar(Parametros.Items[1]); + Result := PChar(Parametros.Items[1]); end; function sel(Parametros: TList): string; @@ -93,7 +93,7 @@ function sel(Parametros: TList): string; valor: String; inicio, qtde: Integer; begin - valor := PAnsiChar(Parametros.Items[2]); + valor := PChar(Parametros.Items[2]); inicio := trunc(Double(Parametros.Items[1]^)); qtde := trunc(Double(Parametros.Items[0]^)); Result := Copy(valor, inicio, qtde); @@ -102,7 +102,7 @@ function sel(Parametros: TList): string; function num(Parametros: TList): Double; begin try - Result := StrToFloat(PAnsiChar(Parametros.Items[0])); + Result := StrToFloat(PChar(Parametros.Items[0])); except Result := 0; end; @@ -112,8 +112,8 @@ function concat(Parametros: TList): string; var v1,v2: string; begin - v1 := PAnsiChar(Parametros.Items[1]); - v2 := PAnsiChar(Parametros.Items[0]); + v1 := PChar(Parametros.Items[1]); + v2 := PChar(Parametros.Items[0]); Result := v1 + v2; end; @@ -129,12 +129,12 @@ function round(Parametros: TList): Double; function masc(Parametros: TList): string; begin - Result := FormatFloat(PAnsiChar(Parametros.Items[1]), Double(Parametros.Items[0]^)); + Result := FormatFloat(PChar(Parametros.Items[1]), Double(Parametros.Items[0]^)); end; function equal(Parametros: TList): Double; begin - if (PAnsiChar(Parametros.Items[1]) = (PAnsiChar(Parametros.Items[0]))) then + if (PChar(Parametros.Items[1]) = (PChar(Parametros.Items[0]))) then Result := 1 else Result := 2; @@ -142,7 +142,7 @@ function equal(Parametros: TList): Double; function trimstr(Parametros: TList): string; begin - Result := Trim(PAnsiChar(Parametros.Items[0])); + Result := Trim(PChar(Parametros.Items[0])); end; end. diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index 3a50ef4..8fbfa9c 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -387,9 +387,8 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); begin if FStrings = nil then FStrings := TStringList.Create; - ValorString := PAnsiChar(AnsiString(FStrings.Strings[ + FpilhaExec.push(PChar(FStrings.Strings[ FStrings.Add(StringReplace(Parametro,'"','',[rfReplaceAll]))])); - FpilhaExec.push(ValorString); end; ord(tiRValue): // variaveis @@ -419,16 +418,17 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); end else begin - ValorString := PAnsiChar(AnsiString(Variavel.Valor)); - FpilhaExec.push(ValorString); + if FStrings = nil then + FStrings := TStringList.Create; + FpilhaExec.push(PChar(FStrings.Strings[ + FStrings.Add(Variavel.Valor)])); end; end else begin if FStrings = nil then FStrings := TStringList.Create; - ValorString := PAnsiChar(FStrings.Strings[FStrings.Add(' ')]); - FpilhaExec.push(ValorString); + FpilhaExec.push(PChar(FStrings.Strings[FStrings.Add(' ')])); end; end; end; From ee3aced6ad963860bd763e9f638ce40796b5ab26 Mon Sep 17 00:00:00 2001 From: Juliano Date: Wed, 19 Mar 2014 16:12:15 -0300 Subject: [PATCH 013/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20na=20fun=C3=A7?= =?UTF-8?q?=C3=A3o=20equal?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index a45aeca..a022972 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -133,8 +133,12 @@ function masc(Parametros: TList): string; end; function equal(Parametros: TList): Double; +var + s1, s2: string; begin - if (PChar(Parametros.Items[1]) = (PChar(Parametros.Items[0]))) then + s1 := PChar(Parametros.Items[1]); + s2 := PChar(Parametros.Items[0]); + if (s1 = s2) then Result := 1 else Result := 2; From 6e33677ebf254639f3da1197793973d800e76f67 Mon Sep 17 00:00:00 2001 From: Juliano Date: Wed, 19 Mar 2014 16:25:15 -0300 Subject: [PATCH 014/294] equal case insensitive --- Lib/osFuncoesParser.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index a022972..98af900 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -138,7 +138,7 @@ function equal(Parametros: TList): Double; begin s1 := PChar(Parametros.Items[1]); s2 := PChar(Parametros.Items[0]); - if (s1 = s2) then + if (UpperCase(s1) = UpperCase(s2)) then Result := 1 else Result := 2; From 02bf1bb39e72567c08a4ed98a4d4486edecfe2d5 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 31 Mar 2014 10:17:42 -0300 Subject: [PATCH 015/294] =?UTF-8?q?inicializa=C3=A7=C3=A3o=20de=20variavel?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osMaquina.pas | 4 +++- package/fw.dpk | 1 - package/fw.dproj | 18 +++++++++++++++++- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index 8fbfa9c..d028255 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -428,7 +428,9 @@ procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); begin if FStrings = nil then FStrings := TStringList.Create; - FpilhaExec.push(PChar(FStrings.Strings[FStrings.Add(' ')])); + Variavel.Valor := ''; + FpilhaExec.push(PChar(FStrings.Strings[ + FStrings.Add(Variavel.Valor)])); end; end; end; diff --git a/package/fw.dpk b/package/fw.dpk index 182bb0f..421c5e6 100644 --- a/package/fw.dpk +++ b/package/fw.dpk @@ -1,7 +1,6 @@ package fw; {$R *.res} -{$R *.otares} {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} {$ALIGN 8} {$ASSERTIONS ON} diff --git a/package/fw.dproj b/package/fw.dproj index b30728f..3ee4907 100644 --- a/package/fw.dproj +++ b/package/fw.dproj @@ -33,6 +33,12 @@ Base true + + true + Cfg_2 + true + true + 2 false @@ -58,7 +64,7 @@ true CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= fw_Icon.ico - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) fw_Icon.ico @@ -74,6 +80,13 @@ false DEBUG;$(DCC_Define) + + 1033 + 0 + 1 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 0 + MainSource @@ -253,6 +266,9 @@ 1.0.0.0 + + Microsoft Office 2000 Sample Automation Server Wrapper Components + False From 3ae4be04764074fbe2a36da5721abd72428c0aba Mon Sep 17 00:00:00 2001 From: desenv6 Date: Fri, 11 Apr 2014 10:19:42 -0300 Subject: [PATCH 016/294] =?UTF-8?q?Adicionada=20a=20nova=20fun=C3=A7=C3=A3?= =?UTF-8?q?o=20CalculaHash?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 06d33fe..1ac2cdf 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -62,6 +62,7 @@ function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; function GetIPAddress: string; +function CalculaHash(conteudo: string): string; implementation @@ -905,4 +906,22 @@ function GetIPAddress: string; Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); end; +function CalculaHash(conteudo: string): string; +var + sum, i : Integer; + HFrame : string; +begin + for i := 1 to Length(conteudo) do + begin + sum := sum + Ord(conteudo[i]); + end; + HFrame := IntToHex(sum mod 256,2); + + if (Length(HFrame) < 2) then + HFrame := '0' + HFrame; + + result := UpperCase(HFrame); +end; + + end. From da4febcff39a57107caf440b0d0e193bda501694 Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 1 May 2014 15:13:44 -0300 Subject: [PATCH 017/294] =?UTF-8?q?convers=C3=A3o=20de=20data?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 90abf94..294bf8e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -61,6 +61,7 @@ function GetGenerator(conn: TosSQLConnection; generator: string): Integer; function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; +function ConverteStrToDate4(data: string): TDateTime; function GetIPAddress: string; implementation @@ -885,6 +886,12 @@ function ConverteStrToDate3(data: string): TDateTime; Copy(data,7,2)+':'+Copy(data,9,2)); end; +//19800515 +function ConverteStrToDate4(data: string): TDateTime; +begin + Result := StrToDate(Copy(data,7,2)+'/'+Copy(data,5,2)+'/'+Copy(data,1,4)); +end; + function GetIPAddress: string; var Buffer: array[0..255] of AnsiChar; From 20b62705cf095d3bbf53be543e23cf2cfae922e7 Mon Sep 17 00:00:00 2001 From: tiago Date: Mon, 19 May 2014 16:16:40 -0300 Subject: [PATCH 018/294] =?UTF-8?q?Ticket=5FID:=20#14406=20-=20Colocando?= =?UTF-8?q?=20fun=C3=A7=C3=A3o=20dentro=20de=20classe?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1ac2cdf..d6d90fb 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -11,6 +11,10 @@ interface type varArrayOfcomps = array of TComponent; + THSHash = class + class function CalculaHash(conteudo: string): string; + end; + function isDigitOrControl(Key: char): boolean; function RemoveAcento(Str:String): String; procedure criarArquivoBackupIB(nomeArq: string); @@ -62,7 +66,6 @@ function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; function GetIPAddress: string; -function CalculaHash(conteudo: string): string; implementation @@ -906,7 +909,7 @@ function GetIPAddress: string; Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); end; -function CalculaHash(conteudo: string): string; +class function THSHash.CalculaHash(conteudo: string): string; var sum, i : Integer; HFrame : string; From 9d140bd37b0cacc0d645fae8fc0596f516dad394 Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 23 May 2014 15:37:09 -0300 Subject: [PATCH 019/294] Ticket_ID: #13262 - Adicionando hash do PCMED/SIL na classe HSHash --- Lib/UtilsUnit.pas | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index dd13f42..dc5c180 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -13,6 +13,7 @@ interface THSHash = class class function CalculaHash(conteudo: string): string; + class function GeraHashPCMed(linha: string): string; end; function isDigitOrControl(Key: char): boolean; @@ -935,4 +936,20 @@ class function THSHash.CalculaHash(conteudo: string): string; end; +class function THSHash.GeraHashPCMed(linha: string): string; +var + i: Integer; + valor: integer; + hexa: string; +begin + valor := 0; + for i := 1 to Length(linha) do + begin + valor := valor + ord(copy(linha,i,1)[1]); + end; + valor := valor mod 256; + hexa := IntToHex(valor,0); + Result := hexa; +end; + end. From 42577107067d1752e40ac9855495c7062d48782d Mon Sep 17 00:00:00 2001 From: Claudio Date: Tue, 27 May 2014 11:20:44 -0300 Subject: [PATCH 020/294] =?UTF-8?q?Ticket=5FID:=20#15167=20-=20Fun=C3=A7?= =?UTF-8?q?=C3=A3o=20que=20converte=20RTF?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index dc5c180..2dc998d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -4,7 +4,7 @@ interface uses IBServices, INIFiles, Forms, AbZipper, Windows, SysUtils, StrUtils, Controls, - osComboSearch, graphics, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, + osComboSearch, graphics, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, osSQLConnection, osSQLQuery, WinSock; @@ -68,6 +68,7 @@ function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; function ConverteStrToDate4(data: string): TDateTime; function GetIPAddress: string; +function ConverteRTF(rtf: string): string; implementation @@ -952,4 +953,25 @@ class function THSHash.GeraHashPCMed(linha: string): string; Result := hexa; end; +function ConverteRTF(rtf: string): string; +var + form: TForm; + richEdit: TRichEdit; + ss: TStringStream; +begin + try + ss := TStringStream.Create(rtf); + form := TForm.Create(nil); + richEdit := TRichEdit.Create(form); + richEdit.Parent := form; + richEdit.Lines.LoadFromStream(ss); + richEdit.PlainText := True; + Result := richEdit.Text; + finally + FreeAndNil(ss); + FreeAndNil(richEdit); + FreeAndNil(form); + end; +end; + end. From 01c713d930b2178586cd9a6cf94573b05797ba10 Mon Sep 17 00:00:00 2001 From: desenv6 Date: Wed, 18 Jun 2014 08:53:13 -0300 Subject: [PATCH 021/294] =?UTF-8?q?Ticket=5FID:=20#15842=20-=20Adicionada?= =?UTF-8?q?=20a=20fun=C3=A7=C3=A3o=20ConverteRTF=20que=20estava=20na=20ver?= =?UTF-8?q?s=C3=A3o=203.0.168?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d6d90fb..8c92546 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -4,7 +4,7 @@ interface uses IBServices, INIFiles, Forms, AbZipper, Windows, SysUtils, StrUtils, Controls, - osComboSearch, graphics, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, + osComboSearch, graphics, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, osSQLConnection, osSQLQuery, WinSock; @@ -66,6 +66,7 @@ function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; function GetIPAddress: string; +function ConverteRTF(rtf: string): string; implementation @@ -927,4 +928,26 @@ class function THSHash.CalculaHash(conteudo: string): string; end; + +function ConverteRTF(rtf: string): string; +var + form: TForm; + richEdit: TRichEdit; + ss: TStringStream; +begin + try + ss := TStringStream.Create(rtf); + form := TForm.Create(nil); + richEdit := TRichEdit.Create(form); + richEdit.Parent := form; + richEdit.Lines.LoadFromStream(ss); + richEdit.PlainText := True; + Result := richEdit.Text; + finally + FreeAndNil(ss); + FreeAndNil(richEdit); + FreeAndNil(form); + end; +end; + end. From f90d95159fe7290108eca25668a0ffd90bbe77e9 Mon Sep 17 00:00:00 2001 From: Jessila Date: Thu, 3 Jul 2014 14:20:42 -0300 Subject: [PATCH 022/294] =?UTF-8?q?Ticket=5FID:=20#16255=20-=20corrigindo?= =?UTF-8?q?=20valida=C3=A7=C3=A3o=20do=20campo=20email=20no=20cadastro=20d?= =?UTF-8?q?e=20paciente?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osErrorHandler.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/osErrorHandler.pas b/Lib/osErrorHandler.pas index 649665a..46f08ea 100644 --- a/Lib/osErrorHandler.pas +++ b/Lib/osErrorHandler.pas @@ -325,7 +325,7 @@ function TosErrorHandlerForm.IsUF(PField: TField): boolean; function TosErrorHandlerForm.IsEmail(PField : TField) : boolean; begin - Result := ExecRegExpr('^[A-Za-z0-9._%+-]+@[A-Za-z0-9-]+\.[A-Za-z]{2,4}(\.[A-Za-z]{2,4})*$', + Result := ExecRegExpr('^[A-Za-z0-9._%+-]+@[A-Za-z0-9-]+\.[A-Za-z0-9-]{2,10}(\.[A-Za-z0-9-]{2,10})*$', PField.AsString); end; From f6e4ec9fe18733664a8e1ad5681d5cbdfcb1316f Mon Sep 17 00:00:00 2001 From: Jessila Date: Thu, 3 Jul 2014 16:10:42 -0300 Subject: [PATCH 023/294] =?UTF-8?q?Ticket=5FID:=20#16255=20-=20Corre=C3=A7?= =?UTF-8?q?=C3=A3o=20valida=C3=A7=C3=A3o=20email?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osErrorHandler.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/osErrorHandler.pas b/Lib/osErrorHandler.pas index 649665a..46f08ea 100644 --- a/Lib/osErrorHandler.pas +++ b/Lib/osErrorHandler.pas @@ -325,7 +325,7 @@ function TosErrorHandlerForm.IsUF(PField: TField): boolean; function TosErrorHandlerForm.IsEmail(PField : TField) : boolean; begin - Result := ExecRegExpr('^[A-Za-z0-9._%+-]+@[A-Za-z0-9-]+\.[A-Za-z]{2,4}(\.[A-Za-z]{2,4})*$', + Result := ExecRegExpr('^[A-Za-z0-9._%+-]+@[A-Za-z0-9-]+\.[A-Za-z0-9-]{2,10}(\.[A-Za-z0-9-]{2,10})*$', PField.AsString); end; From 103b53eef5574e2a51e1ba4731222b01cf54569e Mon Sep 17 00:00:00 2001 From: Juliano Date: Fri, 4 Jul 2014 08:26:35 -0300 Subject: [PATCH 024/294] =?UTF-8?q?tirando=20limita=C3=A7=C3=A3o=20de=20ta?= =?UTF-8?q?manho=20dos=20componentes=20do=20email.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osErrorHandler.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/osErrorHandler.pas b/Lib/osErrorHandler.pas index 46f08ea..4fe9b48 100644 --- a/Lib/osErrorHandler.pas +++ b/Lib/osErrorHandler.pas @@ -325,7 +325,7 @@ function TosErrorHandlerForm.IsUF(PField: TField): boolean; function TosErrorHandlerForm.IsEmail(PField : TField) : boolean; begin - Result := ExecRegExpr('^[A-Za-z0-9._%+-]+@[A-Za-z0-9-]+\.[A-Za-z0-9-]{2,10}(\.[A-Za-z0-9-]{2,10})*$', + Result := ExecRegExpr('^[A-Za-z0-9._%+-]+@[A-Za-z0-9-]+\.[A-Za-z0-9-]{2,}(\.[A-Za-z0-9-]{2,})*$', PField.AsString); end; From b0acf42164b8d2a198cd2919fde7a9571b35da7d Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 14 Jul 2014 10:04:55 -0300 Subject: [PATCH 025/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20de=20gera=C3=A7?= =?UTF-8?q?=C3=A3o=20de=20relat=C3=B3rios=20em=20forma=20de=20texto.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Report/acCustomReportUn.pas | 71 +++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 34 deletions(-) diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 5451d21..12b9235 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -186,9 +186,9 @@ procedure TacCustomReport.Print(const PID: integer); if config.tipoSaida = TSPDF then extensao := 'pdf'; if config.tipoSaida = TSTexto then extensao := 'txt'; if FTextFileName = '' then - if not PromptForFileName(FTextFileName, '*.' + extensao, extensao, - '', '', true) then - exit; + + if not PromptForFileName(FTextFileName, '*.' + extensao, extensao, '', '', true) then + Exit; if config.tipoSaida = TSPDF then SetOutputFile(FTextFileName, rfAcrobat); @@ -200,40 +200,43 @@ procedure TacCustomReport.Print(const PID: integer); report.BeforePrint := beforePrint; linkEvents; - if FPrintToFile then + if (config.tipoSaida <> TSTexto) then begin - if FPDFDevice = nil then + if FPrintToFile then begin - FPDFDevice := TppPDFDevice.Create(Self); - end; - FPDFDevice.FileName := FTextFileName; - FPDFDevice.Publisher := Report.Publisher; - FPDFDevice.PDFSettings := Report.PDFSettings; - end - else if FPrintToStream then - begin - if FPDFDevice = nil then + if FPDFDevice = nil then + begin + FPDFDevice := TppPDFDevice.Create(Self); + end; + FPDFDevice.FileName := FTextFileName; + FPDFDevice.Publisher := Report.Publisher; + FPDFDevice.PDFSettings := Report.PDFSettings; + end + else if FPrintToStream then begin - FPDFDevice := TppPDFDevice.Create(Self); - end; - if FPDFStream <> nil then + if FPDFDevice = nil then + begin + FPDFDevice := TppPDFDevice.Create(Self); + end; + if FPDFStream <> nil then + begin + FreeAndNil(FPDFStream); + end; + FPDFStream := TMemoryStream.Create; + + FPDFDevice.PDFSettings := Report.PDFSettings; + FPDFDevice.OutputStream := FPDFStream; + FPDFDevice.Publisher := Report.Publisher; + end + else if (config.preview) then begin - FreeAndNil(FPDFStream); + report.DeviceType := 'Screen'; + end + else + begin + report.ShowPrintDialog := false; + report.DeviceType := 'Printer'; end; - FPDFStream := TMemoryStream.Create; - - FPDFDevice.PDFSettings := Report.PDFSettings; - FPDFDevice.OutputStream := FPDFStream; - FPDFDevice.Publisher := Report.Publisher; - end - else if config.preview then - begin - report.DeviceType := 'Screen'; - end - else - begin - report.ShowPrintDialog := false; - report.DeviceType := 'Printer'; end; if not FPrintToFile then @@ -291,10 +294,10 @@ procedure TacCustomReport.Print(const PID: integer); report.DeviceType := 'Screen'; end; - if PrintToStream or FPrintToFile then + if (PrintToStream or FPrintToFile) and (config.tipoSaida <> TSTexto) then begin Report.InitializeParameters; - Report.PrintToDevices + Report.PrintToDevices; end else Report.Print; From f89a50f86bfb5ccec11e592574bf1af0fb9258d2 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 14 Jul 2014 11:57:10 -0300 Subject: [PATCH 026/294] =?UTF-8?q?f=C3=B3rmula=20maiusculo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index 700056a..379e014 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -20,6 +20,8 @@ function round(Parametros: TList): Double; forward; function masc(Parametros: TList): string; forward; function equal(Parametros: TList): Double; forward; function trimstr(Parametros: TList): string; forward; +function maiusculo(Parametros: TList): string; forward; + implementation @@ -145,4 +147,9 @@ function trimstr(Parametros: TList): string; Result := Trim(PChar(Parametros.Items[0])); end; +function maiusculo(Parametros: TList): string; +begin + Result := UpperCase(PChar(Parametros.Items[0])); +end; + end. From 30e2436654f3b3ebe19c26e76fa0f2cb310f7c6b Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 17 Jul 2014 18:01:09 -0300 Subject: [PATCH 027/294] formula maiusculo --- Lib/osMaquina.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index bbbc87d..3a7e0e5 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -176,7 +176,8 @@ constructor TosMaquina.Create; FFuncoes.Add(TFuncaoMaquina.Create('ROUND', 1, round)); FFuncoes.Add(TFuncaoMaquina.Create('MASC', 2, masc)); FFuncoes.Add(TFuncaoMaquina.Create('EQUAL', 2, equal)); - FFuncoes.Add(TFuncaoMaquina.Create('TRIM', 1, trimstr)); + FFuncoes.Add(TFuncaoMaquina.Create('TRIM', 1, trimstr)); + FFuncoes.Add(TFuncaoMaquina.Create('MAIUSCULO', 1, maiusculo)); end; destructor TosMaquina.Destroy; From 40d949cd5a80c9375bb3db90b64a37a59335f4dd Mon Sep 17 00:00:00 2001 From: Rogerio Date: Mon, 28 Jul 2014 17:37:31 -0300 Subject: [PATCH 028/294] =?UTF-8?q?Ticket=5FId:=20#16965=20BUG=20na=20fun?= =?UTF-8?q?=C3=A7=C3=A3o=20CalcularHash.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2dc998d..60438c0 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -924,6 +924,7 @@ class function THSHash.CalculaHash(conteudo: string): string; sum, i : Integer; HFrame : string; begin + sum := 0; for i := 1 to Length(conteudo) do begin sum := sum + Ord(conteudo[i]); From cdf7b6ff54a5f28322f36c32786a644ebd128983 Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 31 Jul 2014 15:17:25 -0300 Subject: [PATCH 029/294] =?UTF-8?q?Ticket=5FID:=20#16183=20corre=C3=A7?= =?UTF-8?q?=C3=A3o=20na=20ordena=C3=A7=C3=A3o=20din=C3=A2mica.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osReportUtils.pas | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index a851851..ed83847 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -587,21 +587,13 @@ procedure replaceReportSQLAddParam(report: TppReport; template: TMemoryStream; begin try item := TStringList.Create; - item.Delimiter := '.'; + item.Delimiter := ' '; item.DelimitedText := criterios.Strings[y]; - ord := TdaField.Create(nil); + ord := aSQL.GetFieldForSQLFieldName(item.Strings[0]).Clone(nil); ord.ChildType := 2; - ord.Alias := item.Strings[1]; - ord.FieldAlias := item.Strings[1]; - ord.FieldName := item.Strings[1]; - ord.SQLFieldName := item.Strings[1]; - ord.TableAlias := nomePipeline; - ord.TableSQLAlias := item.Strings[0]; - - // na migração para o XE o comportamento da string list pode mudar - // atualmente independente do caracter de quebra o espaço tbm é quebrado - if (item.Count = 3) and (UpperCase(item.Strings[2]) = 'DESC') then + + if (item.Count = 2) and (UpperCase(item.Strings[1]) = 'DESC') then aSQL.AddOrderByField(ord,False) else aSQL.AddOrderByField(ord,True); From d7272b46665a0f403a7a9b806e895cd4ae927b6c Mon Sep 17 00:00:00 2001 From: Juliano Date: Tue, 19 Aug 2014 09:07:17 -0300 Subject: [PATCH 030/294] eliminando memory leak --- Lib/osReportUtils.pas | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index ed83847..a53dc55 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -136,9 +136,13 @@ function getTemplateById(id: integer; stream: TMemoryStream): boolean; findReportById(id); if Length(report) > 0 then begin - ss := TStringStream.Create(report); - stream.LoadFromStream(ss); - Result := True; + try + ss := TStringStream.Create(report); + stream.LoadFromStream(ss); + Result := True; + finally + FreeAndNil(ss); + end; end else begin From 5e3dd7f61380e3c78b6ef8e00e65cf50f6b60b7b Mon Sep 17 00:00:00 2001 From: Juliano Date: Wed, 27 Aug 2014 11:52:39 -0300 Subject: [PATCH 031/294] =?UTF-8?q?permite=20a=20impress=C3=A3o=20mesmo=20?= =?UTF-8?q?com=20espa=C3=A7o=20no=20nome=20da=20impress=C3=A3o.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 60438c0..47b2590 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -677,12 +677,12 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String); AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); try Rewrite(FBat); - Writeln(FBat, 'TYPE "' + diretorio + 'COMANDO.TXT" > '+impressora); + Writeln(FBat, 'TYPE "' + diretorio + 'COMANDO.TXT" > "'+impressora+'"'); finally CloseFile(FBat); end; - ShellExecute(0, 'Open', PChar(diretorio + 'PRINTLBL.BAT'), nil, nil, Ord(SW_HIDE)); + ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); end; function NomeDaTecla(Key: Word): string; From 6727904d53ed604cc32ad6399b903baf3db229d2 Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 28 Aug 2014 16:24:30 -0300 Subject: [PATCH 032/294] =?UTF-8?q?novas=20fun=C3=B5es=20de=20interfaceame?= =?UTF-8?q?nto.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 15 +++++++++++++++ Lib/osMaquina.pas | 4 +++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index 95f2b75..0679dc1 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -21,6 +21,8 @@ function masc(Parametros: TList): string; forward; function equal(Parametros: TList): Double; forward; function trimstr(Parametros: TList): string; forward; function maiusculo(Parametros: TList): string; forward; +function minusculo(Parametros: TList): string; forward; +function inicial(Parametros: TList): string; forward; implementation @@ -156,4 +158,17 @@ function maiusculo(Parametros: TList): string; Result := UpperCase(PChar(Parametros.Items[0])); end; +function minusculo(Parametros: TList): string; +begin + Result := LowerCase(PChar(Parametros.Items[0])); +end; + +function inicial(Parametros: TList): string; +var + texto: string; +begin + texto := UpperCase(PChar(Parametros.Items[0])); + Result := UpperCase(Copy(texto,1,1))+LowerCase(Copy(texto,2, Length(texto))); +end; + end. diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index 96865e9..684b641 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -177,7 +177,9 @@ constructor TosMaquina.Create; FFuncoes.Add(TFuncaoMaquina.Create('MASC', 2, masc)); FFuncoes.Add(TFuncaoMaquina.Create('EQUAL', 2, equal)); FFuncoes.Add(TFuncaoMaquina.Create('TRIM', 1, trimstr)); - FFuncoes.Add(TFuncaoMaquina.Create('MAIUSCULO', 1, maiusculo)); + FFuncoes.Add(TFuncaoMaquina.Create('MAIUSCULO', 1, maiusculo)); + FFuncoes.Add(TFuncaoMaquina.Create('MINUSCULO', 1, minusculo)); + FFuncoes.Add(TFuncaoMaquina.Create('INICIAL', 1, inicial)); end; destructor TosMaquina.Destroy; From fd3142d934ecc44d6913aa3db58d3722619c642e Mon Sep 17 00:00:00 2001 From: tiago Date: Thu, 28 Aug 2014 17:35:42 -0300 Subject: [PATCH 033/294] =?UTF-8?q?Ticket=5FID:=20#14690=20-=20corre=C3=A7?= =?UTF-8?q?=C3=A3o=20na=20fun=C3=A7=C3=A3o=20isUF?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osErrorHandler.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/osErrorHandler.pas b/Lib/osErrorHandler.pas index 4fe9b48..443342c 100644 --- a/Lib/osErrorHandler.pas +++ b/Lib/osErrorHandler.pas @@ -312,7 +312,7 @@ function TosErrorHandlerForm.IsFullStr(PField: TField): boolean; function TosErrorHandlerForm.IsUF(PField: TField): boolean; const - SiglasValidas = 'RS SC PR SP MS MT RJ ES MG GO BA PE SE AL PI MA RN CE PB PA AM AC RO RR AP TO DF'; + SiglasValidas = ' RS SC PR SP MS MT RJ ES MG GO BA PE SE AL PI MA RN CE PB PA AM AC RO RR AP TO DF '; var SiglaUF : string; begin @@ -320,7 +320,7 @@ function TosErrorHandlerForm.IsUF(PField: TField): boolean; if IsEmpty(SiglaUF) then Result := False else - Result := (Pos(SiglaUF, SiglasValidas) > 0); + Result := (Pos(' '+UpperCase(SiglaUF)+' ', SiglasValidas) > 0); end; function TosErrorHandlerForm.IsEmail(PField : TField) : boolean; From dd7dad58cde8d61f9e7df1c1d134dd6d7eb3ce86 Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 4 Sep 2014 08:28:26 -0300 Subject: [PATCH 034/294] =?UTF-8?q?controle=20de=20mudan=C3=A7a=20de=20tes?= =?UTF-8?q?te?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osWizFrm.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index f7bc443..b35dbfe 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -55,6 +55,7 @@ TosWizForm = class(TosForm) property ShowLogPage: boolean read FShowLogPage write FShowLogPage; property MovingForward: boolean read FMovingForward; property CompleteAction: boolean read FCompleteAction write FCompleteAction; + property MudarTela: boolean read FMudarTela write FMudarTela; end; const From b9a1817b2e5ad1ccf519dd94df5866ebc87f943a Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 15 Sep 2014 10:29:51 -0300 Subject: [PATCH 035/294] Ticket_ID: 17987 - idade paciente --- Lib/osReportUtils.pas | 94 +++++++++++++++++++------------------------ 1 file changed, 42 insertions(+), 52 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index a53dc55..cc97e6d 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -19,7 +19,7 @@ type TIdade = class function getMeses: integer; function getString: string; public - constructor Create(dias: integer); + constructor Create(dias: integer; Data:TDateTime = 0); property dias: integer read getDias; property anos: integer read getAnos; property meses: integer read getMeses; @@ -390,10 +390,13 @@ function ConvertMask(mask: string): string; { TIdade } -constructor TIdade.Create(dias: integer); +constructor TIdade.Create(dias: integer; Data:TDateTime = 0); begin Fdias := dias; - dataReferencia := acCustomSQLMainData.GetServerDate; + if Data = 0 then + dataReferencia := acCustomSQLMainData.GetServerDate + else + dataReferencia := Data; end; function TIdade.getAnos: integer; @@ -452,63 +455,50 @@ function TIdade.getDias: integer; function TIdade.getString: string; var - numDias, numMeses, difMeses, numAnos: integer; - dia, mes, ano: word; - diaAtual, mesAtual, anoAtual: word; - dataNascimento, dataCalculo1, dataCalculo2: TDateTime; - difDias: integer; - iTemp: integer; - strMes: string; + mes, mesano: word; + ano, ano2: Integer; + dataNascimento: TDateTime; + Total_dias: Real; + Count: Integer; begin - numAnos := Fdias div 365; - if (Fdias mod 365) >= 360 then - difMeses := 11 - else - difMeses := (Fdias mod 365) div 30; - numDias := (Fdias mod 365) mod 30; - if Fdias1 then - result := result+'s'; - end; - if (Fdias>=limiarDias) AND (Fdias= DaysInAYear(Ano2) do begin - if difMeses>1 then - result := intToStr(difMeses) + ' meses' - else - if difMeses>0 then - result := intToStr(difMeses) + ' mês'; - if numDias>0 then + if (IsLeapYear(Ano2)) and (Count = 1) then begin - if difMeses>0 then - result := result + ' e '; - if numDias>1 then - result := result + IntToStr(numDias) + ' dias' - else - result := result + IntToStr(numDias) + ' dia'; + Total_dias := Total_dias + 1; end; + Total_dias := Total_dias - DaysInAYear(Ano2); + Ano := Ano + 1; + Ano2 := Ano2 + 1; + inc(count); end; - if (Fdias>=limiarMeses) AND (Fdias 28 do begin - if numAnos > 1 then - result := IntToStr(numAnos) + ' anos' - else - result := IntToStr(numAnos) + ' ano'; - if difMeses>0 then - if difMeses>1 then - result := result + ' e ' + IntToStr(difMeses) + ' meses' + if Total_dias >= DaysInAMonth(Ano, Mes) then + begin + + Total_dias := Total_dias - DaysInAMonth(Ano, mesano); + Mes := Mes + 1; + mesano:= mesano + 1; + if mesano > 12 then + mesano:= 1; + end else - result := result + ' e ' + IntToStr(difMeses) + ' mês'; + break; end; - if Fdias>=limiarAnos then - begin - if numAnos>1 then - result := inttoStr(numAnos) + ' anos' - else - result := inttoStr(numAnos) + ' ano'; - end; - + Ano := Ano - StrToInt(FormatDateTime('YY', DataNascimento)); + Mes := Mes - StrToInt(FormatDateTime('MM', DataNascimento)); + result:= (IntToStr(Ano) + ' anos, ' + IntToStr(Mes) + ' meses e ' + FloatToStr(Total_dias) + ' dias'); end; function getIdadeDias(idade: string): integer; From e4fe9612bbdae26f3f24f6307cb78ec8db69e363 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 15 Sep 2014 10:34:49 -0300 Subject: [PATCH 036/294] Ticket_ID: 17987 - idade paciente --- Lib/osReportUtils.pas | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index cc97e6d..9e8e9a8 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -19,7 +19,7 @@ type TIdade = class function getMeses: integer; function getString: string; public - constructor Create(dias: integer; Data:TDateTime = 0); + constructor Create(dias: integer); property dias: integer read getDias; property anos: integer read getAnos; property meses: integer read getMeses; @@ -390,13 +390,10 @@ function ConvertMask(mask: string): string; { TIdade } -constructor TIdade.Create(dias: integer; Data:TDateTime = 0); +constructor TIdade.Create(dias: integer); begin Fdias := dias; - if Data = 0 then - dataReferencia := acCustomSQLMainData.GetServerDate - else - dataReferencia := Data; + dataReferencia := acCustomSQLMainData.GetServerDate end; function TIdade.getAnos: integer; From 92173c7ad7a35dacc10eebf7aa8c9f77f07cf3ed Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 15 Sep 2014 17:56:26 -0300 Subject: [PATCH 037/294] =?UTF-8?q?Corre=C3=A7=C3=A3o=20texto=20idade=20do?= =?UTF-8?q?=20paciente?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osReportUtils.pas | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 9e8e9a8..048bef1 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -495,7 +495,35 @@ function TIdade.getString: string; end; Ano := Ano - StrToInt(FormatDateTime('YY', DataNascimento)); Mes := Mes - StrToInt(FormatDateTime('MM', DataNascimento)); - result:= (IntToStr(Ano) + ' anos, ' + IntToStr(Mes) + ' meses e ' + FloatToStr(Total_dias) + ' dias'); + + Result:= ''; + if Ano > 0 then + begin + result:= IntToStr(Ano); + if ano > 1 then + result:= result + ' anos ' + else + result:= result + ' ano '; + end; + if (Mes > 0) and (Ano <= 2) then + begin + result:= Result + IntToStr(Mes); + if Mes > 1 then + result:= result + ' meses ' + else + result:= result + ' mes '; + end; + + if (Total_dias > 0) and (Ano < 1) then + begin + result:= Result + FloatToStr(Total_dias); + if Total_dias > 1 then + result:= result + ' dias ' + else + result:= result + ' dia '; + end + else if (Total_dias = 0) and (meses = 12) and (ano = 0) then //recem nascido + result:= '0 dia'; end; function getIdadeDias(idade: string): integer; From 235d94e9ec063dd8a892fc3edaa24aa16a06b1e2 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 24 Sep 2014 17:10:37 -0300 Subject: [PATCH 038/294] =?UTF-8?q?Corre=C3=A7=C3=A3o=20idade=20paciente?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osReportUtils.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 048bef1..3abf9bb 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -491,7 +491,7 @@ function TIdade.getString: string; mesano:= 1; end else - break; + break; end; Ano := Ano - StrToInt(FormatDateTime('YY', DataNascimento)); Mes := Mes - StrToInt(FormatDateTime('MM', DataNascimento)); @@ -507,6 +507,8 @@ function TIdade.getString: string; end; if (Mes > 0) and (Ano <= 2) then begin + if Ano > 0 then + Result:= Result + 'e '; result:= Result + IntToStr(Mes); if Mes > 1 then result:= result + ' meses ' @@ -516,6 +518,8 @@ function TIdade.getString: string; if (Total_dias > 0) and (Ano < 1) then begin + if (Ano > 0) or (Mes > 0) then + Result:= Result + 'e '; result:= Result + FloatToStr(Total_dias); if Total_dias > 1 then result:= result + ' dias ' From c616f51c605a719c3cfb0826f21cdb997e5b234a Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 25 Sep 2014 08:23:25 -0300 Subject: [PATCH 039/294] Ticket_ID: #17987 - adicionando acento --- Lib/osReportUtils.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 3abf9bb..cc9a025 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -513,7 +513,7 @@ function TIdade.getString: string; if Mes > 1 then result:= result + ' meses ' else - result:= result + ' mes '; + result:= result + ' mês '; end; if (Total_dias > 0) and (Ano < 1) then From 67bbac7db623fa4aab72349ae904f74197a5ffcc Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 3 Oct 2014 14:30:50 -0300 Subject: [PATCH 040/294] =?UTF-8?q?Ticket=5FID:=20#13390=20-=20Bug=20Impre?= =?UTF-8?q?ss=C3=A3o=20Fatura?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Report/acCustomReportUn.pas | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 12b9235..4433713 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -110,7 +110,7 @@ TReportClass = class of TacCustomReport; implementation uses acCustomSQLMainDataUn, osReportUtils, acCustomRelatorioDataUn, Dialogs, - acCustomParametroSistemaDataUn; + acCustomParametroSistemaDataUn, osErrorHandler; {$R *.dfm} @@ -179,6 +179,12 @@ procedure TacCustomReport.Print(const PID: integer); begin ajustarAdendos; replaceReportSQLAddWhere(report, stream, PID); + end + else + begin + HError.Clear; + HError.Add('Relatório não encontrado ou parametrizado'); + HError.Check; end; if config.tipoSaida <> TSTela then From d02e2fe8ab9643e918d111c94a456efe0991db9e Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 28 Nov 2014 15:05:05 -0300 Subject: [PATCH 041/294] Ticket_ID: #21483 - Acrescentando acentos no nome da tecla --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 47b2590..3592672 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -739,8 +739,8 @@ function NomeDaTecla(Key: Word): string; VK_F10: Result := '[F10]'; //F10 key VK_F11: Result := '[F11]'; //F11 key VK_F12: Result := '[F12]'; //F12 key - 219: Result := ''; //´ acento - 222: Result := ''; //~ acento + 219: Result := '´'; //´ acento + 222: Result := '~'; //~ acento else GetKeyboardState(keyboardState); SetLength(Result, 2) ; From 756f9d095372ef5f38f700e8700bb3c6299e49d5 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 1 Dec 2014 16:24:13 -0200 Subject: [PATCH 042/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20na=20convers=C3=A3?= =?UTF-8?q?o=20de=20teclas?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 47b2590..65aab3d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -743,7 +743,7 @@ function NomeDaTecla(Key: Word): string; 222: Result := ''; //~ acento else GetKeyboardState(keyboardState); - SetLength(Result, 2) ; + SetLength(Result, 4) ; asciiResult := ToAscii(key, MapVirtualKey(key, 0), keyboardState, @Result[1], 0) ; case asciiResult of 0: Result := ''; From 025d6daa1bbfb39b2bcd6cc4441f2d82c76cf716 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 5 Dec 2014 11:48:50 -0200 Subject: [PATCH 043/294] =?UTF-8?q?Ticket=5FID:=20#21483=20-=20N=C3=A3o=20?= =?UTF-8?q?exibir=20"=3F"=20na=20tela=20de=20usuario=20aba=20de=20atributo?= =?UTF-8?q?s?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 65aab3d..1939c89 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -743,7 +743,7 @@ function NomeDaTecla(Key: Word): string; 222: Result := ''; //~ acento else GetKeyboardState(keyboardState); - SetLength(Result, 4) ; + SetLength(Result, 10) ; asciiResult := ToAscii(key, MapVirtualKey(key, 0), keyboardState, @Result[1], 0) ; case asciiResult of 0: Result := ''; From f72f232a2b970e7032058ac6baf8af1fdffc551e Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 5 Feb 2015 16:52:52 -0200 Subject: [PATCH 044/294] =?UTF-8?q?Ticket=5FID:=20#23930=20-=20Importa?= =?UTF-8?q?=C3=A7=C3=A3o=20resultado=20rtf=20(ConverteTextoToRTF)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1939c89..4df6de6 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -69,6 +69,7 @@ function ConverteStrToDate3(data: string): TDateTime; function ConverteStrToDate4(data: string): TDateTime; function GetIPAddress: string; function ConverteRTF(rtf: string): string; +function ConverteTextoToRTF(Texto: string): string; implementation @@ -975,4 +976,26 @@ function ConverteRTF(rtf: string): string; end; end; +function ConverteTextoToRTF(Texto: string): string; +var + form: TForm; + richEdit: TRichEdit; + ss: TStringStream; +begin + try + ss := TStringStream.Create(Texto); + form := TForm.Create(nil); + richEdit := TRichEdit.Create(form); + richEdit.Parent := form; + richEdit.Text:= Texto; + richEdit.PlainText := True; + richEdit.Lines.SaveToStream(ss); + Result := ss.DataString; + finally + FreeAndNil(ss); + FreeAndNil(richEdit); + FreeAndNil(form); + end; +end; + end. From 3b28a54c7ebd1e7d6b17b5c12059409f5ccec0cd Mon Sep 17 00:00:00 2001 From: Juliano Date: Thu, 5 Feb 2015 17:07:27 -0200 Subject: [PATCH 045/294] =?UTF-8?q?convers=C3=A3o=20para=20RTF?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 4df6de6..f2faf28 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -988,7 +988,7 @@ function ConverteTextoToRTF(Texto: string): string; richEdit := TRichEdit.Create(form); richEdit.Parent := form; richEdit.Text:= Texto; - richEdit.PlainText := True; + richEdit.PlainText := False; richEdit.Lines.SaveToStream(ss); Result := ss.DataString; finally From 07aca39f3beea17993903f9242066fb770599a90 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 2 Mar 2015 10:29:44 -0300 Subject: [PATCH 046/294] =?UTF-8?q?Corre=C3=A7=C3=A3o=20nas=20f=C3=B3rmula?= =?UTF-8?q?s.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index 0679dc1..25db748 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -142,7 +142,7 @@ function equal(Parametros: TList): Double; begin s1 := PChar(Parametros.Items[1]); s2 := PChar(Parametros.Items[0]); - if (UpperCase(s1) = UpperCase(s2)) then + if (AnsiUpperCase(s1) = AnsiUpperCase(s2)) then Result := 1 else Result := 2; @@ -155,20 +155,20 @@ function trimstr(Parametros: TList): string; function maiusculo(Parametros: TList): string; begin - Result := UpperCase(PChar(Parametros.Items[0])); + Result := AnsiUpperCase(PChar(Parametros.Items[0])); end; function minusculo(Parametros: TList): string; begin - Result := LowerCase(PChar(Parametros.Items[0])); + Result := AnsiLowerCase(PChar(Parametros.Items[0])); end; function inicial(Parametros: TList): string; var texto: string; begin - texto := UpperCase(PChar(Parametros.Items[0])); - Result := UpperCase(Copy(texto,1,1))+LowerCase(Copy(texto,2, Length(texto))); + texto := AnsiUpperCase(PChar(Parametros.Items[0])); + Result := AnsiUpperCase(Copy(texto,1,1))+AnsiLowerCase(Copy(texto,2, Length(texto))); end; end. From 2707799b4cf820008ef479028d7ca056162e1075 Mon Sep 17 00:00:00 2001 From: Juliano Date: Mon, 27 Apr 2015 11:49:52 -0300 Subject: [PATCH 047/294] Ticket_ID: #27156 colocando meses na idade --- .gitignore | 13 ++++++------- Lib/osReportUtils.pas | 2 +- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/.gitignore b/.gitignore index b0ab88c..67084f9 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,6 @@ -/package/fw.dof -/dcu_7/*.dcu - -/Forms/*.ddp -/Datamodules/*.ddp -/package/*.identcache -/package/*.otares +*.dof +*.dcu +*.ddp +*.identcache +*.otares +*.~*~ \ No newline at end of file diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index cc9a025..3b807b3 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -505,7 +505,7 @@ function TIdade.getString: string; else result:= result + ' ano '; end; - if (Mes > 0) and (Ano <= 2) then + if (Mes > 0) then begin if Ano > 0 then Result:= Result + 'e '; From 61afdc08ec1e0e8e746a4ed92baa2164025ff3f1 Mon Sep 17 00:00:00 2001 From: jonathan Date: Mon, 4 May 2015 09:34:09 -0300 Subject: [PATCH 048/294] =?UTF-8?q?Inclus=C3=A3o=20de=20Fun=C3=A7=C3=B5es?= =?UTF-8?q?=20de=20LOG?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 291 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 290 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1939c89..68e2cbd 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -11,10 +11,15 @@ interface type varArrayOfcomps = array of TComponent; + TFuncaoParametroGetDesc = function(const vValor : Variant) : string; + THSHash = class class function CalculaHash(conteudo: string): string; class function GeraHashPCMed(linha: string): string; end; + +const + sMODELOMSGLOG = #13+#13+'Campo %s alterado.'+#13+'De: %s'+#13+'Para: %s'; function isDigitOrControl(Key: char): boolean; function RemoveAcento(Str:String): String; @@ -69,10 +74,28 @@ function ConverteStrToDate3(data: string): TDateTime; function ConverteStrToDate4(data: string): TDateTime; function GetIPAddress: string; function ConverteRTF(rtf: string): string; +function FieldHasChanged(aField : TField):Boolean; +function ValueIsEmptyNull(aValue : Variant):Boolean; +function getDescricaoSexo(const vValor : Variant):String; +function getDescricaoSimNao(const vValor : Variant):String; +function getDescricaoTipoResultado(const vValor : Variant):String; +function CriarMsgLogAlteracaoField(aField : TField):String; overload; +function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; +function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; + const sCampoChave: String; const sCampoRetorno: String):String; +function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCamposLOG: Array of String): String; +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +function CriarMsgLogInclusaoExclusaoCDS(oCds: TClientDataSet; oCdsBase: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String): String; +function CriarMsgLogCDSNotLocateOrigemDestino(oCdsOrigem: TClientDataSet; oCdsDestino: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; +function isRTFValue(vValor: Variant): Boolean; //{\rtf +function getCampoSemRTF(const vValor : Variant):String; + implementation -uses DateUtils, Variants; +uses DateUtils, Variants, StatusUnit; const CSIDL_COMMON_APPDATA = $0023; @@ -975,4 +998,270 @@ function ConverteRTF(rtf: string): string; end; end; +function FieldHasChanged(aField : TField):Boolean; +begin + case AField.DataType of + ftString : Result := Trim(VarToStrDef(aField.OldValue,'')) <> Trim(VarToStrDef(aField.NewValue,'')); + ftMemo : Result := Trim(VarToStrDef(aField.OldValue,'')) <> Trim(VarToStrDef(aField.NewValue,'')); + else + if ValueIsEmptyNull(aField.OldValue) and ValueIsEmptyNull(aField.NewValue) then + result := False + else + Result := aField.OldValue <> aField.NewValue; + end; +end; + +function ValueIsEmptyNull(aValue : Variant):Boolean; +begin + Result := VarIsEmpty(aValue) or VarIsNull(aValue) or (VarToStr(aValue) = EmptyStr); +end; + +function getDescricaoSexo(const vValor : Variant):String; +var + cValor : Char; +begin + cValor := Char(AnsiString(vValor)[1]); + case cValor of + spMasculino : Result := 'Masculino'; + spFeminino : Result := 'Feminino'; + spAmbos : Result := 'Ambos'; + else + result := ''; + end; +end; + +function getDescricaoSimNao(const vValor : Variant):String; +var + cValor : Char; +begin + cValor := Char(AnsiString(vValor)[1]); + case cValor of + 'S' : Result := 'Sim'; + 'N' : Result := 'Não'; + else + result := ''; + end; +end; + +function getDescricaoTipoResultado(const vValor : Variant):String; +var + cValor : Char; +begin + cValor := Char(AnsiString(vValor)[1]); + case cValor of + 'G' : Result := 'Germe'; + 'N' : Result := 'Número'; + 'P' : Result := 'Parasita'; + 'T' : Result := 'Texto'; + 'L' : Result := 'Título'; + else + result := ''; + end; +end; + +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +var + field : TStringField; + nCol: Integer; +begin + if not Assigned(cdsDestino) then + cdsDestino := TClientDataSet.Create(nil); + + for nCol := 0 to cdsOrigem.FieldCount-1 do + begin + field := TStringField.Create(cdsDestino); + Field.FieldKind := fkData; + Field.FieldName := cdsOrigem.Fields[nCol].FieldName; + Field.DataSet := cdsDestino; + end; + cdsDestino.Close; + cdsDestino.CreateDataSet; + + cdsOrigem.First; + while not cdsOrigem.Eof do + begin + cdsDestino.Append; + for nCol := 0 to cdsOrigem.FieldCount-1 do + begin + cdsDestino.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString := + cdsOrigem.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString; + end; + cdsDestino.Post; + cdsOrigem.Next; + end; +end; + +function CriarMsgLogAlteracaoField(aField : TField):String; overload; +begin + Result := EmptyStr; + if FieldHasChanged(aField) then + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), + getCampoSemRTF(aField.NewValue)]); + +end; + +function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; +begin + Result := EmptyStr; + if FieldHasChanged(aField) then + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, aFuncaoGetDescricao(aField.OldValue), + aFuncaoGetDescricao(aField.NewValue)]); +end; + +function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet;const sCampoChave: String; + const sCampoRetorno: String):String; +var + sDescOld, sDescNew : String; +begin + sDescOld := EmptyStr; + sDescNew := EmptyStr; + Result := EmptyStr; + if FieldHasChanged(aField) then + begin + if not ValueIsEmptyNull(aField.OldValue) then + sDescOld := oCDSLookup.Lookup(sCampoChave, aField.OldValue, sCampoRetorno); + if not ValueIsEmptyNull(aField.NewValue) then + sDescNew := oCDSLookup.Lookup(sCampoChave, aField.NewValue, sCampoRetorno); + + if (sDescOld <> EmptyStr) or (sDescNew <> EmptyStr) then + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, sDescOld, sDescNew]); + end; +end; + +function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCamposLOG: Array of String): String; +var + nRegCol : Integer; + aBookMarkReg : TBookmark; + aMsgReg, aMsgAlt : String; +begin + Result := EmptyStr; + if (oCDS = nil) or (not oCDS.Active) or (oCDS.RecordCount = 0) then + Exit; + aBookMarkReg := oCDS.Bookmark; + oCDS.DisableControls; + try + oCDS.First; + while not oCDS.Eof do + begin + aMsgReg := EmptyStr; + aMsgAlt := EmptyStr; + // loga se não for inclusão + if not ValueIsEmptyNull(oCDS.FieldByName(oCDS.Fields[0].FieldName).OldValue) then + begin + // Todos os Campos + if Length(aCamposLOG)=0 then + begin + for nRegCol := 0 to oCDS.FieldCount-1 do + begin + if oCDS.FieldByName(oCDS.Fields[nRegCol].FieldName).FieldKind <> fkLookup then + aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( + oCDS.FieldByName(oCDS.Fields[nRegCol].FieldName) ); + end; + end + // campos do Array + else + begin + for nRegCol := 0 to Length(aCamposLOG)-1 do + begin + aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(aCamposLOG[nRegCol]) ); + end; + end; + + if (Length(aCamposDescricao) > 0) and (aMsgAlt <> EmptyStr) then + begin + aMsgReg := EmptyStr; + for nRegCol := 0 to Length(aCamposDescricao)-1 do + begin + if aMsgReg <> EmptyStr then + aMsgReg := aMsgReg + ', '; + aMsgReg := aMsgReg + getCampoSemRTF(oCDS.FieldByName(aCamposDescricao[nRegCol]).AsString); + end; + aMsgReg := #13 + #13 + 'Alterado ' + aMsgReg; + end; + + // Copy retira uma linha no começo da mensagem dos campos + if aMsgAlt <> EmptyStr then + Result := Result + aMsgReg + Copy(aMsgAlt, 2, length(aMsgAlt)); + end; + oCDS.Next; + end; + finally + oCDS.GotoBookmark(aBookMarkReg); + oCDS.EnableControls; + end; +end; + +function CriarMsgLogInclusaoExclusaoCDS(oCds: TClientDataSet; oCdsBase: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String): String; +var + aBookMarkReg : TBookmark; +begin + Result := EmptyStr; + aBookMarkReg := oCds.Bookmark; + oCds.DisableControls; + try + // Verifica Registros Excluidos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(oCdsBase, oCds, sCampoChave, aCampoDescricao, + 'Exclusão: '); + + // Verifica Registros Incluídos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(oCds, oCdsBase, sCampoChave, aCampoDescricao, + 'Inclusão: '); + finally + oCds.GotoBookmark(aBookMarkReg); + oCds.EnableControls; + end; +end; + +function CriarMsgLogCDSNotLocateOrigemDestino(oCdsOrigem: TClientDataSet; oCdsDestino: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; +var + nRegCol : Integer; + aMsgReg : String; +begin + Result := EmptyStr; + oCdsOrigem.First; + while not oCdsOrigem.Eof do + begin + if not oCdsDestino.Locate(sCampoChave, oCdsOrigem.FieldByName(sCampoChave).AsVariant, []) then + begin + if Length(aCampoDescricao) > 0 then + begin + aMsgReg := EmptyStr; + for nRegCol := 0 to Length(aCampoDescricao)-1 do + begin + if aMsgReg <> EmptyStr then + aMsgReg := aMsgReg + ', '; + aMsgReg := aMsgReg + getCampoSemRTF(oCdsOrigem.FieldByName(aCampoDescricao[nRegCol]).AsString); + end; + end; + + Result := Result + #13 + sDescricao + aMsgReg; + end; + oCdsOrigem.Next; + end; +end; + +function isRTFValue(vValor: Variant): Boolean; +begin + Result := False; + if not ValueIsEmptyNull(vValor) then + Result := Copy(vValor, 1, 5) = '{\rtf'; +end; + +function getCampoSemRTF(const vValor : Variant):String; +var + sValor : String; +begin + result := EmptyStr; + if not ValueIsEmptyNull(vValor) then + begin + sValor := VarToStr(vValor); + if isRTFValue(sValor) then + result := ConverteRTF(sValor) + else + result := sValor; + end; +end; + end. From 0a5d772d129039b22f3ca0e9bb9d494e282bc60f Mon Sep 17 00:00:00 2001 From: jonathan Date: Mon, 4 May 2015 15:26:23 -0300 Subject: [PATCH 049/294] =?UTF-8?q?Corre=C3=A7=C3=A3o=20getDescri=C3=A7?= =?UTF-8?q?=C3=A3o=20e=20cria=C3=A7=C3=A3o=20de=20log?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 38 ++++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 16 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 9f19b87..a1ec354 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1043,7 +1043,7 @@ function getDescricaoSexo(const vValor : Variant):String; var cValor : Char; begin - cValor := Char(AnsiString(vValor)[1]); + cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); case cValor of spMasculino : Result := 'Masculino'; spFeminino : Result := 'Feminino'; @@ -1057,7 +1057,7 @@ function getDescricaoSimNao(const vValor : Variant):String; var cValor : Char; begin - cValor := Char(AnsiString(vValor)[1]); + cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); case cValor of 'S' : Result := 'Sim'; 'N' : Result := 'Não'; @@ -1070,7 +1070,7 @@ function getDescricaoTipoResultado(const vValor : Variant):String; var cValor : Char; begin - cValor := Char(AnsiString(vValor)[1]); + cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); case cValor of 'G' : Result := 'Germe'; 'N' : Result := 'Número'; @@ -1084,22 +1084,30 @@ function getDescricaoTipoResultado(const vValor : Variant):String; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); var - field : TStringField; + field : TField; nCol: Integer; begin if not Assigned(cdsDestino) then cdsDestino := TClientDataSet.Create(nil); - - for nCol := 0 to cdsOrigem.FieldCount-1 do + + if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin - field := TStringField.Create(cdsDestino); - Field.FieldKind := fkData; - Field.FieldName := cdsOrigem.Fields[nCol].FieldName; - Field.DataSet := cdsDestino; - end; - cdsDestino.Close; - cdsDestino.CreateDataSet; + for nCol := 0 to cdsOrigem.FieldCount-1 do + begin + if (cdsOrigem.Fields[nCol]) is TMemoField then + field := TMemoField.Create(cdsDestino) + else + field := TStringField.Create(cdsDestino); + + Field.FieldKind := fkData; + Field.FieldName := cdsOrigem.Fields[nCol].FieldName; + Field.DataSet := cdsDestino; + end; + cdsDestino.Close; + cdsDestino.CreateDataSet; + end; + cdsOrigem.First; while not cdsOrigem.Eof do begin @@ -1220,7 +1228,6 @@ function CriarMsgLogInclusaoExclusaoCDS(oCds: TClientDataSet; oCdsBase: TClientD aBookMarkReg : TBookmark; begin Result := EmptyStr; - aBookMarkReg := oCds.Bookmark; oCds.DisableControls; try // Verifica Registros Excluidos @@ -1231,7 +1238,6 @@ function CriarMsgLogInclusaoExclusaoCDS(oCds: TClientDataSet; oCdsBase: TClientD Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(oCds, oCdsBase, sCampoChave, aCampoDescricao, 'Inclusão: '); finally - oCds.GotoBookmark(aBookMarkReg); oCds.EnableControls; end; end; @@ -1256,7 +1262,7 @@ function CriarMsgLogCDSNotLocateOrigemDestino(oCdsOrigem: TClientDataSet; oCdsDe if aMsgReg <> EmptyStr then aMsgReg := aMsgReg + ', '; aMsgReg := aMsgReg + getCampoSemRTF(oCdsOrigem.FieldByName(aCampoDescricao[nRegCol]).AsString); - end; + end; end; Result := Result + #13 + sDescricao + aMsgReg; From d941b4a3c278463c38d78287481c0b5a4df4334b Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 6 May 2015 08:32:22 -0300 Subject: [PATCH 050/294] Ticket_ID: #27815 - Usando constantes no getDescricaoTipoResultado --- Lib/UtilsUnit.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index beeae19..380a7d2 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1072,11 +1072,11 @@ function getDescricaoTipoResultado(const vValor : Variant):String; begin cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); case cValor of - 'G' : Result := 'Germe'; - 'N' : Result := 'Número'; - 'P' : Result := 'Parasita'; - 'T' : Result := 'Texto'; - 'L' : Result := 'Título'; + satrGerme : Result := 'Germe'; + satrNumerico : Result := 'Número'; + satrParasita : Result := 'Parasita'; + satrTexto : Result := 'Texto'; + satrTitulo : Result := 'Título'; else result := ''; end; From 70151bf3292c8a0326947eaa9df5d2e5a72dcc75 Mon Sep 17 00:00:00 2001 From: Juliano Date: Wed, 6 May 2015 09:30:46 -0300 Subject: [PATCH 051/294] nome de variaveis --- Lib/UtilsUnit.pas | 90 +++++++++++++++++++++++------------------------ 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a1ec354..08a7d06 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -86,9 +86,9 @@ function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDat const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCamposLOG: Array of String): String; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); -function CriarMsgLogInclusaoExclusaoCDS(oCds: TClientDataSet; oCdsBase: TClientDataSet; +function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; -function CriarMsgLogCDSNotLocateOrigemDestino(oCdsOrigem: TClientDataSet; oCdsDestino: TClientDataSet; +function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; function isRTFValue(vValor: Variant): Boolean; //{\rtf function getCampoSemRTF(const vValor : Variant):String; @@ -621,7 +621,7 @@ function ValidaIntervalo(inicio: string; fim: string; permiteIgual: Boolean): Bo tamInicio, tamFim: Integer; begin tamInicio := Length(inicio); - tamFim := Length(fim); + tamFim := Length(fim); horaInicio := StrToIntDef(Trim(Copy(inicio,0,tamInicio-3)),0); minutoInicio := StrToIntDef(Trim(Copy(inicio,tamInicio-1,2)),0); horaFim := StrToIntDef(Trim(Copy(fim,0,tamFim-3)),0); @@ -1025,7 +1025,7 @@ function FieldHasChanged(aField : TField):Boolean; begin case AField.DataType of ftString : Result := Trim(VarToStrDef(aField.OldValue,'')) <> Trim(VarToStrDef(aField.NewValue,'')); - ftMemo : Result := Trim(VarToStrDef(aField.OldValue,'')) <> Trim(VarToStrDef(aField.NewValue,'')); + ftMemo : Result := Trim(VarToStrDef(aField.OldValue,'')) <> Trim(VarToStrDef(aField.NewValue,'')); else if ValueIsEmptyNull(aField.OldValue) and ValueIsEmptyNull(aField.NewValue) then result := False @@ -1040,7 +1040,7 @@ function ValueIsEmptyNull(aValue : Variant):Boolean; end; function getDescricaoSexo(const vValor : Variant):String; -var +var cValor : Char; begin cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); @@ -1083,10 +1083,10 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); -var +var field : TField; nCol: Integer; -begin +begin if not Assigned(cdsDestino) then cdsDestino := TClientDataSet.Create(nil); @@ -1096,17 +1096,17 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC begin if (cdsOrigem.Fields[nCol]) is TMemoField then field := TMemoField.Create(cdsDestino) - else - field := TStringField.Create(cdsDestino); - + else + field := TStringField.Create(cdsDestino); + Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[nCol].FieldName; Field.DataSet := cdsDestino; - end; + end; cdsDestino.Close; cdsDestino.CreateDataSet; end; - + cdsOrigem.First; while not cdsOrigem.Eof do @@ -1114,19 +1114,19 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC cdsDestino.Append; for nCol := 0 to cdsOrigem.FieldCount-1 do begin - cdsDestino.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString := + cdsDestino.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString := cdsOrigem.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString; end; cdsDestino.Post; cdsOrigem.Next; - end; + end; end; function CriarMsgLogAlteracaoField(aField : TField):String; overload; begin Result := EmptyStr; if FieldHasChanged(aField) then - Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), getCampoSemRTF(aField.NewValue)]); end; @@ -1140,8 +1140,8 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca end; function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet;const sCampoChave: String; - const sCampoRetorno: String):String; -var + const sCampoRetorno: String):String; +var sDescOld, sDescNew : String; begin sDescOld := EmptyStr; @@ -1162,13 +1162,13 @@ function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDat function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCamposLOG: Array of String): String; var nRegCol : Integer; - aBookMarkReg : TBookmark; + aBookMarkReg : TBookmark; aMsgReg, aMsgAlt : String; begin Result := EmptyStr; if (oCDS = nil) or (not oCDS.Active) or (oCDS.RecordCount = 0) then Exit; - aBookMarkReg := oCDS.Bookmark; + aBookMarkReg := oCDS.Bookmark; oCDS.DisableControls; try oCDS.First; @@ -1185,7 +1185,7 @@ function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCampos for nRegCol := 0 to oCDS.FieldCount-1 do begin if oCDS.FieldByName(oCDS.Fields[nRegCol].FieldName).FieldKind <> fkLookup then - aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( + aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(oCDS.Fields[nRegCol].FieldName) ); end; end @@ -1195,22 +1195,22 @@ function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCampos for nRegCol := 0 to Length(aCamposLOG)-1 do begin aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(aCamposLOG[nRegCol]) ); - end; + end; end; - + if (Length(aCamposDescricao) > 0) and (aMsgAlt <> EmptyStr) then begin aMsgReg := EmptyStr; for nRegCol := 0 to Length(aCamposDescricao)-1 do begin if aMsgReg <> EmptyStr then - aMsgReg := aMsgReg + ', '; + aMsgReg := aMsgReg + ', '; aMsgReg := aMsgReg + getCampoSemRTF(oCDS.FieldByName(aCamposDescricao[nRegCol]).AsString); end; aMsgReg := #13 + #13 + 'Alterado ' + aMsgReg; - end; + end; - // Copy retira uma linha no começo da mensagem dos campos + // Copy retira uma linha no começo da mensagem dos campos if aMsgAlt <> EmptyStr then Result := Result + aMsgReg + Copy(aMsgAlt, 2, length(aMsgAlt)); end; @@ -1222,52 +1222,52 @@ function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCampos end; end; -function CriarMsgLogInclusaoExclusaoCDS(oCds: TClientDataSet; oCdsBase: TClientDataSet; +function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; -var +var aBookMarkReg : TBookmark; begin - Result := EmptyStr; - oCds.DisableControls; + Result := EmptyStr; + AlteradoCDS.DisableControls; try - // Verifica Registros Excluidos - Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(oCdsBase, oCds, sCampoChave, aCampoDescricao, + // Verifica Registros Excluidos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS, AlteradoCDS, sCampoChave, aCampoDescricao, 'Exclusão: '); // Verifica Registros Incluídos - Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(oCds, oCdsBase, sCampoChave, aCampoDescricao, - 'Inclusão: '); + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(AlteradoCDS, OriginalCDS, sCampoChave, aCampoDescricao, + 'Inclusão: '); finally - oCds.EnableControls; + AlteradoCDS.EnableControls; end; end; -function CriarMsgLogCDSNotLocateOrigemDestino(oCdsOrigem: TClientDataSet; oCdsDestino: TClientDataSet; +function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; var nRegCol : Integer; aMsgReg : String; begin Result := EmptyStr; - oCdsOrigem.First; - while not oCdsOrigem.Eof do + OriginalCDS.First; + while not OriginalCDS.Eof do begin - if not oCdsDestino.Locate(sCampoChave, oCdsOrigem.FieldByName(sCampoChave).AsVariant, []) then - begin + if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then + begin if Length(aCampoDescricao) > 0 then begin aMsgReg := EmptyStr; for nRegCol := 0 to Length(aCampoDescricao)-1 do begin if aMsgReg <> EmptyStr then - aMsgReg := aMsgReg + ', '; - aMsgReg := aMsgReg + getCampoSemRTF(oCdsOrigem.FieldByName(aCampoDescricao[nRegCol]).AsString); - end; + aMsgReg := aMsgReg + ', '; + aMsgReg := aMsgReg + getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); + end; end; - - Result := Result + #13 + sDescricao + aMsgReg; + + Result := Result + #13 + sDescricao + aMsgReg; end; - oCdsOrigem.Next; + OriginalCDS.Next; end; end; From 66ba80719ba1cac5f88d6868394edaf1233222a5 Mon Sep 17 00:00:00 2001 From: Juliano Date: Wed, 6 May 2015 13:42:56 -0300 Subject: [PATCH 052/294] passando o campo chave --- Lib/UtilsUnit.pas | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 41a813c..231ffc5 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -84,7 +84,7 @@ function CriarMsgLogAlteracaoField(aField : TField):String; overload; function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; -function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCamposLOG: Array of String): String; +function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; @@ -1085,22 +1085,22 @@ function getDescricaoTipoResultado(const vValor : Variant):String; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); var field : TField; - nCol: Integer; + i: Integer; begin if not Assigned(cdsDestino) then cdsDestino := TClientDataSet.Create(nil); if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin - for nCol := 0 to cdsOrigem.FieldCount-1 do + for i := 0 to cdsOrigem.FieldCount-1 do begin - if (cdsOrigem.Fields[nCol]) is TMemoField then + if (cdsOrigem.Fields[i]) is TMemoField then field := TMemoField.Create(cdsDestino) else field := TStringField.Create(cdsDestino); Field.FieldKind := fkData; - Field.FieldName := cdsOrigem.Fields[nCol].FieldName; + Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DataSet := cdsDestino; end; cdsDestino.Close; @@ -1112,10 +1112,10 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC while not cdsOrigem.Eof do begin cdsDestino.Append; - for nCol := 0 to cdsOrigem.FieldCount-1 do + for i := 0 to cdsOrigem.FieldCount-1 do begin - cdsDestino.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString := - cdsOrigem.FieldByName(cdsDestino.Fields[nCol].FieldName).AsString; + cdsDestino.FieldByName(cdsDestino.Fields[i].FieldName).AsString := + cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).AsString; end; cdsDestino.Post; cdsOrigem.Next; @@ -1159,16 +1159,16 @@ function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDat end; end; -function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCamposLOG: Array of String): String; +function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; var - nRegCol : Integer; - aBookMarkReg : TBookmark; + i : Integer; + bm : TBookmark; aMsgReg, aMsgAlt : String; begin Result := EmptyStr; if (oCDS = nil) or (not oCDS.Active) or (oCDS.RecordCount = 0) then Exit; - aBookMarkReg := oCDS.Bookmark; + bm := oCDS.Bookmark; oCDS.DisableControls; try oCDS.First; @@ -1177,35 +1177,35 @@ function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCampos aMsgReg := EmptyStr; aMsgAlt := EmptyStr; // loga se não for inclusão - if not ValueIsEmptyNull(oCDS.FieldByName(oCDS.Fields[0].FieldName).OldValue) then + if not ValueIsEmptyNull(oCDS.FieldByName(key).OldValue) then begin // Todos os Campos if Length(aCamposLOG)=0 then begin - for nRegCol := 0 to oCDS.FieldCount-1 do + for i := 0 to oCDS.FieldCount-1 do begin - if oCDS.FieldByName(oCDS.Fields[nRegCol].FieldName).FieldKind <> fkLookup then + if oCDS.FieldByName(oCDS.Fields[i].FieldName).FieldKind <> fkLookup then aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( - oCDS.FieldByName(oCDS.Fields[nRegCol].FieldName) ); + oCDS.FieldByName(oCDS.Fields[i].FieldName) ); end; end // campos do Array else begin - for nRegCol := 0 to Length(aCamposLOG)-1 do + for i := 0 to Length(aCamposLOG)-1 do begin - aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(aCamposLOG[nRegCol]) ); + aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(aCamposLOG[i]) ); end; end; if (Length(aCamposDescricao) > 0) and (aMsgAlt <> EmptyStr) then begin aMsgReg := EmptyStr; - for nRegCol := 0 to Length(aCamposDescricao)-1 do + for i := 0 to Length(aCamposDescricao)-1 do begin if aMsgReg <> EmptyStr then aMsgReg := aMsgReg + ', '; - aMsgReg := aMsgReg + getCampoSemRTF(oCDS.FieldByName(aCamposDescricao[nRegCol]).AsString); + aMsgReg := aMsgReg + getCampoSemRTF(oCDS.FieldByName(aCamposDescricao[i]).AsString); end; aMsgReg := #13 + #13 + 'Alterado ' + aMsgReg; end; @@ -1217,7 +1217,7 @@ function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; aCamposDescricao, aCampos oCDS.Next; end; finally - oCDS.GotoBookmark(aBookMarkReg); + oCDS.GotoBookmark(bm); oCDS.EnableControls; end; end; From 9bec2f6c16393bb2cb1e5d3b9c44a75222150bbd Mon Sep 17 00:00:00 2001 From: Juliano Date: Fri, 8 May 2015 16:36:26 -0300 Subject: [PATCH 053/294] =?UTF-8?q?mostrando=20o=20sql=20m=C3=A1gico=20qua?= =?UTF-8?q?ndo=20estiver=20marcado=20para=20exibir=20consulta?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/ImprimirRelatorioFormUn.dfm | 3 +-- Forms/ImprimirRelatorioFormUn.pas | 2 +- Lib/osReportUtils.pas | 4 +++- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/Forms/ImprimirRelatorioFormUn.dfm b/Forms/ImprimirRelatorioFormUn.dfm index 7150da2..e5b9437 100644 --- a/Forms/ImprimirRelatorioFormUn.dfm +++ b/Forms/ImprimirRelatorioFormUn.dfm @@ -1,6 +1,5 @@ inherited ImprimirRelatorioForm: TImprimirRelatorioForm Caption = 'ImprimirRelatorioForm' - ExplicitHeight = 355 PixelsPerInch = 96 TextHeight = 13 object ComboFilter: TosComboFilter [1] @@ -28,7 +27,7 @@ inherited ImprimirRelatorioForm: TImprimirRelatorioForm end inherited ImageList: TImageList Bitmap = { - 494C010101000400100010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010101000400180010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Forms/ImprimirRelatorioFormUn.pas b/Forms/ImprimirRelatorioFormUn.pas index 08da9f3..8bc5afe 100644 --- a/Forms/ImprimirRelatorioFormUn.pas +++ b/Forms/ImprimirRelatorioFormUn.pas @@ -35,7 +35,7 @@ TImprimirRelatorioForm = class(TosCustomEditForm) implementation uses osReportUtils, acCustomSQLMainDataUn, osFrm, acCustomParametroSistemaDataUn, - acCustomReportUn; + acCustomReportUn, ReportUn; {$R *.dfm} diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 3b807b3..1e06809 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -7,7 +7,7 @@ interface daQueryDataView, ppTypes,daIDE, daDBExpress, ppCTDsgn, raIDE, myChkBox, ppModule, FMTBcd, osCustomDataSetProvider, SqlExpr, osSQLDataSetProvider, daSQl, osSQLQuery, osComboFilter, ppDBPipe, osClientDataSet, - acReportContainer, Forms; + acReportContainer, Forms, osCustomMainFrm; type TIdade = class private @@ -630,6 +630,8 @@ procedure replaceReportSQLAddParam(report: TppReport; template: TMemoryStream; end; end; end; + if osCustomMainForm.ShowQueryAction.Checked then + ShowMessage(aSQL.MagicSQLText.Text); end; end; end; From e136c739a09bf5c66f6edb3a87f08b4f213f3f4e Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 7 Aug 2015 15:55:20 -0300 Subject: [PATCH 054/294] ticket_id: #31553 - adicionando um close transaction ao maindata --- Datamodules/acCustomSQLMainDataUn.pas | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 176a209..a0e6468 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -47,6 +47,7 @@ TacCustomSQLMainData = class(TDataModule) SQLConnectionMeta: TosSQLConnection; procedure DataModuleCreate(Sender: TObject); private + protected BD: string; FQueryList: TObjectList; @@ -83,6 +84,7 @@ TacCustomSQLMainData = class(TDataModule) procedure StartTransaction; procedure Commit; procedure Rollback; + procedure CloseTransaction; function GetNewID(nomeGenerator: String = ''): integer; function GetGeneratorValue(nomeGenerator: String): integer; procedure GetUserInfo(apelido: string); @@ -524,6 +526,11 @@ procedure TacCustomSQLMainData.StartTransaction; end; end; +procedure TacCustomSQLMainData.CloseTransaction; +begin + SQLConnection.Close; +end; + {-------------------------------------------------------------------------  Objetivo   > Registra qual o ClientDataset de Lookup deve ser atualizado quando uma determinada tabela for alterada, isto é quando From 545f502e14d81fccd98689b48b19a9a6136102f8 Mon Sep 17 00:00:00 2001 From: Claudio <------@labplus.com.br> Date: Wed, 26 Aug 2015 15:59:23 -0300 Subject: [PATCH 055/294] Ticket_ID: #32487 - adicionando setHabilitaComboBox --- Lib/UtilsUnit.pas | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 231ffc5..9165cff 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -35,6 +35,7 @@ procedure setHabilitaDBEdit(edt: TDBEdit; enabled: boolean); procedure setHabilitaButton(btn: TButton; enabled: boolean); procedure setHabilitaSpeedButton(btn: TSpeedButton; enabled: boolean); procedure setHabilitawwComboBox(comboBox: TwwDBComboBox; enabled: boolean); +procedure setHabilitaComboBox(comboBox: TComboBox; enabled: boolean); procedure setHabilitawwDateTimePicker(dateTimePicker: TwwDBDateTimePicker; enabled: boolean); function roundToCurr(val: double): double; procedure setHabilitaDBCheckBox(edtd: TDBCheckBox; enabled: boolean); @@ -308,6 +309,20 @@ procedure setHabilitawwComboBox(comboBox: TwwDBComboBox; enabled: boolean); end; end; +procedure setHabilitaComboBox(comboBox: TComboBox; enabled: boolean); +begin + if enabled then + begin + comboBox.Enabled := True; + comboBox.Color := clWhite; + end + else + begin + comboBox.Enabled := False; + comboBox.Color := clBtnFace; + end; +end; + procedure setHabilitawwDateTimePicker(dateTimePicker: TwwDBDateTimePicker; enabled: boolean); begin if enabled then From 16bbde44bdcc91cf7a1729de9cc9aa7561977917 Mon Sep 17 00:00:00 2001 From: tiago Date: Wed, 26 Aug 2015 16:08:01 -0300 Subject: [PATCH 056/294] =?UTF-8?q?ticket=5Fid:=20#32760=20-=20adicionando?= =?UTF-8?q?=20fun=C3=A7=C3=A3o=20util=20para=20atribui=C3=A7=C3=A3o=20de?= =?UTF-8?q?=20stringlist?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 231ffc5..2870ad2 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -91,7 +91,8 @@ function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; function isRTFValue(vValor: Variant): Boolean; //{\rtf -function getCampoSemRTF(const vValor : Variant):String; +function getCampoSemRTF(const vValor : Variant):String; +function FormataStringList(texto, delimitador: string): string; implementation @@ -101,6 +102,12 @@ implementation const CSIDL_COMMON_APPDATA = $0023; +function FormataStringList(texto, delimitador: string): string; +begin + Result := '"' + StringReplace(texto, + delimitador, '"' + delimitador + '"', [rfReplaceAll]) + '"'; +end; + // 20001020 function ConverteData(data: string): TDateTime; begin From 6f73fea76918851ab953d34c5cef60adf1860c33 Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Mon, 19 Oct 2015 15:21:18 -0200 Subject: [PATCH 057/294] =?UTF-8?q?Retirada=20da=20funcionalidade=20"ShowL?= =?UTF-8?q?ogPage"=20tal=20funcionalidade=20fazia=20com=20que=20alguns=20f?= =?UTF-8?q?orms=20do=20sistema,=20n=C3=A3o=20fechassem=20em=20sua=20finali?= =?UTF-8?q?za=C3=A7=C3=A3o.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osWizFrm.pas | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index b35dbfe..f13850c 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -34,7 +34,6 @@ TosWizForm = class(TosForm) procedure FormShow(Sender: TObject); procedure pgcWizardChanging(Sender: TObject; var AllowChange: Boolean); private - FShowLogPage: boolean; FMovingForward: boolean; FCompleteAction: boolean; FMudarTela: Boolean; @@ -52,7 +51,6 @@ TosWizForm = class(TosForm) function PageCount : integer; procedure Log(const PMessage: string; const Args: array of const; const PTime: boolean = True); property IndexLastPage: integer read GetIndexLastPage; - property ShowLogPage: boolean read FShowLogPage write FShowLogPage; property MovingForward: boolean read FMovingForward; property CompleteAction: boolean read FCompleteAction write FCompleteAction; property MudarTela: boolean read FMudarTela write FMudarTela; @@ -111,23 +109,20 @@ procedure TosWizForm.btnAvancarClick(Sender: TObject); begin if btnAvancar.Caption = constConcluirCaption then begin - pgcWizard.Visible := False; - try - btnVoltar.Enabled := False; - NextPage; - UpdatePage; - btnAvancar.Enabled := False; - btnCancelar.Caption := constFecharCaption; - btnCancelar.Enabled := False; - WizardConclusion; - except - pgcWizard.Visible := True; - raise; - end; - if FShowLogPage then - btnCancelar.Enabled := True - else - Close; + pgcWizard.Visible := False; + try + btnVoltar.Enabled := False; + NextPage; + UpdatePage; + btnAvancar.Enabled := False; + btnCancelar.Caption := constFecharCaption; + btnCancelar.Enabled := False; + WizardConclusion; + except + pgcWizard.Visible := True; + raise; + end; + Close; end else NextPage; @@ -217,7 +212,6 @@ function TosWizForm.GetIndexLastPage: integer; procedure TosWizForm.FormShow(Sender: TObject); begin FMudarTela := False; - ShowLogPage := True; btnAvancar.Enabled := True; btnCancelar.Caption := constCancelarCaption; btnCancelar.Enabled := True; From 86136d473d24dd631e83f299d621648e0ab3b59b Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 16 Dec 2015 15:49:52 -0200 Subject: [PATCH 058/294] =?UTF-8?q?Ticket=5FID=20#37813=20-=20Corrigir=20p?= =?UTF-8?q?roblema=20de=20ac=C3=BAmulo=20de=20mem=C3=B3ria?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1f9fcb5..2a3ebe9 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -94,7 +94,7 @@ function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; Alter function isRTFValue(vValor: Variant): Boolean; //{\rtf function getCampoSemRTF(const vValor : Variant):String; function FormataStringList(texto, delimitador: string): string; - +procedure TrimAppMemorySize; implementation @@ -1315,4 +1315,18 @@ function getCampoSemRTF(const vValor : Variant):String; end; end; +procedure TrimAppMemorySize; +var + MainHandle : THandle; +begin + try + MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID) ; + SetProcessWorkingSetSize(MainHandle, $FFFFFFFF, $FFFFFFFF) ; + CloseHandle(MainHandle) ; + except + end; + Application.ProcessMessages; +end; + + end. From c5586aa514f412489d76a73df7ddafc457d364e9 Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Tue, 22 Dec 2015 11:30:20 -0200 Subject: [PATCH 059/294] Ticked_ID: #37300 Atalho de Pesquisa dos Menus --- Forms/osCustomMainFrm.dfm | 96 ++++++++++++++++++++++------------- Forms/osCustomMainFrm.pas | 103 +++++++++++++++++++++++++++++++++++++- 2 files changed, 162 insertions(+), 37 deletions(-) diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index ea3e235..d1b30b8 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -8,8 +8,9 @@ inherited osCustomMainForm: TosCustomMainForm Menu = MainMenu Visible = True WindowState = wsMaximized - ExplicitWidth = 1024 - ExplicitHeight = 703 + ExplicitTop = -30 + ExplicitWidth = 1016 + ExplicitHeight = 699 PixelsPerInch = 96 TextHeight = 13 object ControlBar: TControlBar [0] @@ -195,24 +196,30 @@ inherited osCustomMainForm: TosCustomMainForm end> end object Panel2: TPanel [2] - Left = 161 + Left = 0 Top = 37 - Width = 847 + Width = 1008 Height = 589 Align = alClient BevelOuter = bvNone TabOrder = 2 + object Splitter1: TSplitter + Left = 165 + Top = 33 + Width = 4 + Height = 556 + end object WebBrowser: TWebBrowser - Left = 0 + Left = 169 Top = 33 - Width = 847 + Width = 839 Height = 556 Align = alClient TabOrder = 2 - ExplicitWidth = 735 - ExplicitHeight = 540 + ExplicitLeft = 185 + ExplicitWidth = 823 ControlData = { - 4C0000008A570000773900000000000000000000000000000000000000000000 + 4C000000B7560000773900000000000000000000000000000000000000000000 000000004C000000000000000000000001000000E0D057007335CF11AE690800 2B2E12620A000000000000004C0000000114020000000000C000000000000046 8000000000000000000000000000000000000000000000000000000000000000 @@ -221,7 +228,7 @@ inherited osCustomMainForm: TosCustomMainForm object ResourcePanel: TPanel Left = 0 Top = 0 - Width = 847 + Width = 1008 Height = 33 Align = alTop Alignment = taLeftJustify @@ -268,6 +275,42 @@ inherited osCustomMainForm: TosCustomMainForm TitleImageList = ArrowsImageList PaintOptions.AlternatingRowColor = clWhite end + object Panel1: TPanel + Left = 0 + Top = 33 + Width = 165 + Height = 556 + Align = alLeft + TabOrder = 3 + object TreeView1: TTreeView + Left = 1 + Top = 1 + Width = 163 + Height = 533 + Align = alClient + Color = clBtnFace + HotTrack = True + Images = BarSmallImages + Indent = 19 + MultiSelectStyle = [msControlSelect, msShiftSelect] + ShowLines = False + ShowRoot = False + StateImages = BarSmallImages + TabOrder = 0 + OnChange = TreeView1Change + OnCustomDrawItem = TreeView1CustomDrawItem + end + object EdtPesquisa: TEdit + Left = 1 + Top = 534 + Width = 163 + Height = 21 + Align = alBottom + TabOrder = 1 + OnChange = EdtPesquisaChange + OnKeyDown = EdtPesquisaKeyDown + end + end end object RelatPanel: TPanel [3] Left = 333 @@ -705,23 +748,6 @@ inherited osCustomMainForm: TosCustomMainForm end end end - object TreeView1: TTreeView [4] - Left = 0 - Top = 37 - Width = 161 - Height = 589 - Align = alLeft - Color = clBtnFace - HotTrack = True - Images = BarSmallImages - Indent = 19 - MultiSelectStyle = [msControlSelect, msShiftSelect] - ShowLines = False - ShowRoot = False - StateImages = BarSmallImages - TabOrder = 4 - OnChange = TreeView1Change - end inherited ActionList: TosActionList Images = MainImageList Left = 784 @@ -847,7 +873,7 @@ inherited osCustomMainForm: TosCustomMainForm OnExecute = LogoutActionExecute end end - object MainMenu: TMainMenu [6] + object MainMenu: TMainMenu [5] Left = 812 Top = 72 object Arquivo: TMenuItem @@ -920,12 +946,12 @@ inherited osCustomMainForm: TosCustomMainForm Caption = 'Ajuda' end end - object FilterDatasource: TDataSource [7] + object FilterDatasource: TDataSource [6] DataSet = FilterDataset Left = 724 Top = 112 end - object FilterDataset: TosClientDataset [8] + object FilterDataset: TosClientDataset [7] Aggregates = <> FetchOnDemand = False Params = <> @@ -938,7 +964,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 696 Top = 112 end - object PopupMenu: TPopupMenu [9] + object PopupMenu: TPopupMenu [8] Left = 812 Top = 112 object Novo1: TMenuItem @@ -979,7 +1005,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 4 Top = 96 Bitmap = { - 494C0101010004003C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101010003003C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000800000002000000001002000000000000040 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000CECEBD00C6C6BD00C6BDB500C6BDB500C6BD @@ -1518,7 +1544,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 36 Top = 96 Bitmap = { - 494C0101010004003C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101010003003C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2022,7 +2048,7 @@ inherited osCustomMainForm: TosCustomMainForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 279401 PrinterSetup.mmPaperWidth = 215900 - PrinterSetup.PaperSize = 119 + PrinterSetup.PaperSize = 120 Template.DatabaseSettings.DataPipeline = plItem Template.DatabaseSettings.NameField = 'Name' Template.DatabaseSettings.TemplateField = 'Template' @@ -2095,7 +2121,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 674 Top = 52 Bitmap = { - 494C01010A000E003C0016001600FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01010A000C003C0016001600FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000058000000420000000100200000000000C05A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index cf8e496..3c06ca1 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -126,7 +126,6 @@ TosCustomMainForm = class(TosForm) EfetuarBackupemarquivolocal1: TMenuItem; SaveBackupDialog: TSaveDialog; FFilterDepot: TacFilterController; - TreeView1: TTreeView; pnlPreviewBar: TPanel; spbPreviewPrint: TSpeedButton; spbPreviewWhole: TSpeedButton; @@ -140,6 +139,10 @@ TosCustomMainForm = class(TosForm) mskPreviewPercentage: TMaskEdit; spbPreviewCancel: TSpeedButton; FReportDepot: TacReportContainer; + Panel1: TPanel; + TreeView1: TTreeView; + EdtPesquisa: TEdit; + Splitter1: TSplitter; procedure EditActionExecute(Sender: TObject); procedure ViewActionExecute(Sender: TObject); procedure NewActionExecute(Sender: TObject); @@ -190,6 +193,10 @@ TosCustomMainForm = class(TosForm) procedure GridCalcCellColors(Sender: TObject; Field: TField; State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush); + procedure EdtPesquisaChange(Sender: TObject); + procedure TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; + var DefaultDraw: Boolean); + procedure EdtPesquisaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FNewFilter: boolean; FUserName: string; @@ -216,7 +223,7 @@ TosCustomMainForm = class(TosForm) // e ignorar o caractere se desejado CtrlOrAltPressed: boolean; FSuperUserLogged: boolean; - + FIndiceMenu : Integer; procedure SetEditForm(const Value: TosCustomEditForm); procedure SetActionDblClick(const Value: TAction); function GetSelectedList: TStringList; @@ -258,6 +265,7 @@ TosCustomMainForm = class(TosForm) property ActionDblClick: TAction read FActionDblClick write SetActionDblClick; procedure ExecLastFilter; function getReportByResource(name: string; stream: TMemoryStream): boolean; + procedure PesquisaMenu(pOrigem: Integer; pIndice : Integer); published property EditForm: TosCustomEditForm read FEditForm write SetEditForm; property SelectedList: TStringList read GetSelectedList; @@ -286,6 +294,7 @@ constructor TosCustomMainForm.Create(AOwner: TComponent); vViews: variant; begin inherited; + FIndiceMenu := 0; FNewFilter := true; FActionDblClick := EditAction; FSelectedList := TStringListExt.Create; @@ -942,6 +951,32 @@ procedure TosCustomMainForm.PaginaInicial(Sender: TObject); ShowHomePage(true); end; +procedure TosCustomMainForm.PesquisaMenu(pOrigem: Integer; pIndice : Integer); +var + i,vTamanho: integer; + vNo: ttreenode; +begin + vTamanho := length(EdtPesquisa.text); + if vTamanho > 2 then + begin + for i := pIndice to TreeView1.Items.Count-1 do + begin + if Pos(UpperCase(EdtPesquisa.text), UpperCase(TreeView1.Items[i].Text)) > 0 then + begin + vNo := TreeView1.Items[i]; + TreeView1.Select(vNo); + if pOrigem = 0 then + break + else + begin + FIndiceMenu := i ; + pOrigem := 0; + end; + end; + end; + end; +end; + procedure TosCustomMainForm.GridCalcTitleImage(Sender: TObject; Field: TField; var TitleImageAttributes: TwwTitleImageAttributes); begin @@ -1558,6 +1593,50 @@ procedure TosCustomMainForm.EditarTodosButtonClick(Sender: TObject); end; +procedure TosCustomMainForm.EdtPesquisaChange(Sender: TObject); +begin + inherited; + FIndiceMenu := 0; + Self.PesquisaMenu(0,FIndiceMenu); +end; + +procedure TosCustomMainForm.EdtPesquisaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +var + vNo : TTreeNode; +begin + inherited; + if key = vk_return then + begin + Self.PesquisaMenu(1,FIndiceMenu+1) + end + else + if (key = VK_DOWN) or (key = VK_UP) or (key = VK_RIGHT) then + begin + if KEY = VK_DOWN then + BEGIN + if (TreeView1.Items.Count-1) > FIndiceMenu then + begin + vNo := TreeView1.Items[FIndiceMenu+1]; + TreeView1.Select(vNo); + inc(FIndiceMenu); + end; + END + else if KEY = VK_UP then + begin + if FIndiceMenu > 0 then + begin + vNo := TreeView1.Items[FIndiceMenu-1]; + TreeView1.Select(vNo); + dec(FIndiceMenu); + end; + end + else if KEY = VK_RIGHT then + begin + Self.TreeView1Change(Self, TreeView1.Items[FIndiceMenu]); + end; + end; +end; + procedure TosCustomMainForm.EfetuarBackupemarquivolocal1Click( Sender: TObject); var @@ -1654,6 +1733,26 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; PrintAction.Enabled := (FCurrentResource.ReportClassName <> ''); end; +procedure TosCustomMainForm.TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; + State: TCustomDrawState; var DefaultDraw: Boolean); +begin + inherited; + + if Node.Selected then + begin + Sender.Canvas.Brush.Color := clInfoBk; + Sender.Canvas.Font.Color := clBlack; + end + else + begin + Sender.Canvas.Brush.Color := TTreeView(Sender).Color; + Sender.Canvas.Font.Color := TTreeView(Sender).Font.Color; + end; + +end; + + + procedure TosCustomMainForm.GridCalcCellColors(Sender: TObject; Field: TField; State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush); From 5681549f1392ffdf736f494e8cc1005099592935 Mon Sep 17 00:00:00 2001 From: francisco Date: Tue, 22 Dec 2015 16:34:52 -0200 Subject: [PATCH 060/294] ticket_id: #37300 - atalho de pesquisa --- Forms/osCustomMainFrm.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 3c06ca1..fdd0b15 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -224,6 +224,7 @@ TosCustomMainForm = class(TosForm) CtrlOrAltPressed: boolean; FSuperUserLogged: boolean; FIndiceMenu : Integer; + FUltimoIndiceMenu : Integer; procedure SetEditForm(const Value: TosCustomEditForm); procedure SetActionDblClick(const Value: TAction); function GetSelectedList: TStringList; @@ -1607,7 +1608,16 @@ procedure TosCustomMainForm.EdtPesquisaKeyDown(Sender: TObject; var Key: Word; S inherited; if key = vk_return then begin - Self.PesquisaMenu(1,FIndiceMenu+1) + if (FUltimoIndiceMenu > 0) and (FIndiceMenu = FUltimoIndiceMenu) then + begin + FIndiceMenu := 0; + Self.PesquisaMenu(0,FIndiceMenu); + end + else + begin + FUltimoIndiceMenu := FIndiceMenu; + Self.PesquisaMenu(1,FIndiceMenu+1); + end; end else if (key = VK_DOWN) or (key = VK_UP) or (key = VK_RIGHT) then From 954e8691a506ee1d608c11a098946f9676a4d61e Mon Sep 17 00:00:00 2001 From: Claudio <------@labplus.com.br> Date: Fri, 19 Feb 2016 09:19:14 -0200 Subject: [PATCH 061/294] =?UTF-8?q?Tciket=5FID:=20#40722=20-=20Corre=C3=A7?= =?UTF-8?q?=C3=A3o=20para=20formulas=20do=20paciente=20funcionar=20no=20in?= =?UTF-8?q?terf?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osReportUtils.pas | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 1e06809..49b884b 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -19,7 +19,7 @@ type TIdade = class function getMeses: integer; function getString: string; public - constructor Create(dias: integer); + constructor Create(dias: integer; referencia: TDateTime = 0); property dias: integer read getDias; property anos: integer read getAnos; property meses: integer read getMeses; @@ -390,10 +390,13 @@ function ConvertMask(mask: string): string; { TIdade } -constructor TIdade.Create(dias: integer); +constructor TIdade.Create(dias: integer; referencia: TDateTime = 0); begin Fdias := dias; - dataReferencia := acCustomSQLMainData.GetServerDate + if referencia = 0 then + dataReferencia := acCustomSQLMainData.GetServerDate + else + dataReferencia := referencia end; function TIdade.getAnos: integer; From 23be1170cced5e824652dc91edce9652f9847dbd Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 31 Mar 2016 09:49:36 -0300 Subject: [PATCH 062/294] =?UTF-8?q?ticket=5Fid:=20#42087=20-=20Retirada=20?= =?UTF-8?q?do=20Var=20na=20passagem=20do=20par=C3=A2metro,=20pois=20os=20p?= =?UTF-8?q?onteiros=20passados=20como=20par=C3=A2metros=20j=C3=A1=20s?= =?UTF-8?q?=C3=A3o=20tratados=20como=20passagem=20por=20refer=C3=AAncia=20?= =?UTF-8?q?(var=20=C3=A9=20desnecess=C3=A1rio)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2a3ebe9..3a2884b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -86,7 +86,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1104,7 +1104,7 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); var field : TField; i: Integer; From b647bf53a4177f4c1fa53d2385244928fc05128d Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Fri, 8 Apr 2016 11:10:42 -0300 Subject: [PATCH 063/294] =?UTF-8?q?-=20Flags,=20que=20podem=20identificar,?= =?UTF-8?q?=20em=20qual=20bot=C3=A3o=20clicou,=20Avancar=20/=20Voltar.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osWizFrm.pas | 70 +++++++++++++++++++++++++++------------------- 1 file changed, 41 insertions(+), 29 deletions(-) diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index f13850c..b5d34fa 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -41,6 +41,8 @@ TosWizForm = class(TosForm) protected procedure UpdatePage; virtual; public + FBotaoAvancar : Boolean; + FBotaoVoltar : Boolean; procedure WizardConclusion; virtual; procedure NextPage; virtual; procedure PreviousPage; virtual; @@ -90,42 +92,52 @@ procedure TosWizForm.UpdatePage; procedure TosWizForm.btnVoltarClick(Sender: TObject); begin inherited; - FMudarTela := True; - CompleteAction := True; - FMovingForward := False; - OnLeavePage.Execute; - if CompleteAction then - PreviousPage; + try + FBotaoVoltar := True; + FMudarTela := True; + CompleteAction := True; + FMovingForward := False; + OnLeavePage.Execute; + if CompleteAction then + PreviousPage; + finally + FBotaoVoltar := False ; + end; end; procedure TosWizForm.btnAvancarClick(Sender: TObject); begin inherited; - FMudarTela := True; - CompleteAction := True; - FMovingForward := True; - OnLeavePage.Execute; - if CompleteAction then - begin - if btnAvancar.Caption = constConcluirCaption then + try + FBotaoAvancar := True; + FMudarTela := True; + CompleteAction := True; + FMovingForward := True; + OnLeavePage.Execute; + if CompleteAction then begin - pgcWizard.Visible := False; - try - btnVoltar.Enabled := False; + if btnAvancar.Caption = constConcluirCaption then + begin + pgcWizard.Visible := False; + try + btnVoltar.Enabled := False; + NextPage; + UpdatePage; + btnAvancar.Enabled := False; + btnCancelar.Caption := constFecharCaption; + btnCancelar.Enabled := False; + WizardConclusion; + except + pgcWizard.Visible := True; + raise; + end; + Close; + end + else NextPage; - UpdatePage; - btnAvancar.Enabled := False; - btnCancelar.Caption := constFecharCaption; - btnCancelar.Enabled := False; - WizardConclusion; - except - pgcWizard.Visible := True; - raise; - end; - Close; - end - else - NextPage; + end; + finally + FBotaoAvancar := False; end; end; From ec0454d7242c07d76aad68c5250e9ea21aa3eb74 Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 15 Apr 2016 15:54:41 -0300 Subject: [PATCH 064/294] =?UTF-8?q?Desfazendo=20flags=20de=20bot=C3=A3o=20?= =?UTF-8?q?avan=C3=A7ar=20e=20retroceder,=20deve=20ser=20usado=20o=20movin?= =?UTF-8?q?gforward?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osWizFrm.pas | 70 +++++++++++++++++++--------------------------- 1 file changed, 29 insertions(+), 41 deletions(-) diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index b5d34fa..f13850c 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -41,8 +41,6 @@ TosWizForm = class(TosForm) protected procedure UpdatePage; virtual; public - FBotaoAvancar : Boolean; - FBotaoVoltar : Boolean; procedure WizardConclusion; virtual; procedure NextPage; virtual; procedure PreviousPage; virtual; @@ -92,52 +90,42 @@ procedure TosWizForm.UpdatePage; procedure TosWizForm.btnVoltarClick(Sender: TObject); begin inherited; - try - FBotaoVoltar := True; - FMudarTela := True; - CompleteAction := True; - FMovingForward := False; - OnLeavePage.Execute; - if CompleteAction then - PreviousPage; - finally - FBotaoVoltar := False ; - end; + FMudarTela := True; + CompleteAction := True; + FMovingForward := False; + OnLeavePage.Execute; + if CompleteAction then + PreviousPage; end; procedure TosWizForm.btnAvancarClick(Sender: TObject); begin inherited; - try - FBotaoAvancar := True; - FMudarTela := True; - CompleteAction := True; - FMovingForward := True; - OnLeavePage.Execute; - if CompleteAction then + FMudarTela := True; + CompleteAction := True; + FMovingForward := True; + OnLeavePage.Execute; + if CompleteAction then + begin + if btnAvancar.Caption = constConcluirCaption then begin - if btnAvancar.Caption = constConcluirCaption then - begin - pgcWizard.Visible := False; - try - btnVoltar.Enabled := False; - NextPage; - UpdatePage; - btnAvancar.Enabled := False; - btnCancelar.Caption := constFecharCaption; - btnCancelar.Enabled := False; - WizardConclusion; - except - pgcWizard.Visible := True; - raise; - end; - Close; - end - else + pgcWizard.Visible := False; + try + btnVoltar.Enabled := False; NextPage; - end; - finally - FBotaoAvancar := False; + UpdatePage; + btnAvancar.Enabled := False; + btnCancelar.Caption := constFecharCaption; + btnCancelar.Enabled := False; + WizardConclusion; + except + pgcWizard.Visible := True; + raise; + end; + Close; + end + else + NextPage; end; end; From 61c2a71fba7fa31eaa9c79d3289f228ef6dbd550 Mon Sep 17 00:00:00 2001 From: Claudio <------@labplus.com.br> Date: Mon, 9 May 2016 15:34:33 -0300 Subject: [PATCH 065/294] =?UTF-8?q?Ticket=5FID:=20#44155=20-=20Usando=20va?= =?UTF-8?q?r=20no=20ClonarDadosClientDataSet=20para=20corrigir=20exception?= =?UTF-8?q?=20na=20edi=C3=A7=C3=A3o=20de=20valor=20de=20referencia=20no=20?= =?UTF-8?q?cadastro=20de=20vers=C3=A3o=20de=20exame?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 3a2884b..2a3ebe9 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -86,7 +86,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1104,7 +1104,7 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); var field : TField; i: Integer; From 37273660721036f47a71871ff8365f0d1d77b491 Mon Sep 17 00:00:00 2001 From: francisco Date: Mon, 23 May 2016 15:03:39 -0300 Subject: [PATCH 066/294] =?UTF-8?q?ticket=5Fid:=20#44548=20-=20corre=C3=A7?= =?UTF-8?q?=C3=A3o=20do=20calculo=20de=20dias=20do=20ano?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osReportUtils.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 49b884b..87c996b 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -544,7 +544,7 @@ function getIdadeDias(idade: string): integer; case tipoIdade[1] of 'd': fatorMult := 1; 'm': fatorMult := 30; - 'a': fatorMult := 360; + 'a': fatorMult := 365; end; original := StrToInt(copy(idade, 1, length(idade)-1)); result := original * fatorMult; From f06f786a80fa752dbe028db3e583b69a3c0e85e7 Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 27 May 2016 09:43:23 -0300 Subject: [PATCH 067/294] ticket_id: #44808 - preview do relatorio maximizado --- Report/acCustomReportUn.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 4433713..e318e97 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -552,7 +552,8 @@ function TacCustomReport.casosEspeciais(valorOriginal: string): string; procedure TacCustomReport.ReportPreviewFormCreate(Sender: TObject); begin - // + report.PreviewForm.WindowState := wsMaximized; + TppViewer(report.Previewform.Viewer).ZoomSetting := zs100Percent end; function TacCustomReport.getPaperName(printerName: String): String; From 0cbdc713b7166113292f508e196d6b4e4cf10f91 Mon Sep 17 00:00:00 2001 From: Wellington Date: Fri, 27 May 2016 14:34:12 -0300 Subject: [PATCH 068/294] Ticket_id: #44808 - Ajuste para funcionar tambem nos Relatorios, com Auxilio do Danilo e do Francisco --- Forms/ImprimirRelatorioFormUn.pas | 3 ++- Report/acCustomReportUn.dfm | 6 ++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/Forms/ImprimirRelatorioFormUn.pas b/Forms/ImprimirRelatorioFormUn.pas index 8bc5afe..8c5b6c2 100644 --- a/Forms/ImprimirRelatorioFormUn.pas +++ b/Forms/ImprimirRelatorioFormUn.pas @@ -224,7 +224,8 @@ function TImprimirRelatorioForm.findPipeline(name: string): TppDataPipeline; procedure TImprimirRelatorioForm.ReportPreviewFormCreate(Sender: TObject); begin inherited; - report.PreviewForm.WindowState := wsMaximized; + report.PreviewFormSettings.ZoomSetting := zs100Percent; + report.PreviewFormSettings.WindowState := wsMaximized; end; function TImprimirRelatorioForm.findComponentUserName(name: String): TComponent; diff --git a/Report/acCustomReportUn.dfm b/Report/acCustomReportUn.dfm index a1aec8c..4369d2f 100644 --- a/Report/acCustomReportUn.dfm +++ b/Report/acCustomReportUn.dfm @@ -2,8 +2,6 @@ object acCustomReport: TacCustomReport OldCreateOrder = False OnCreate = DataModuleCreate OnDestroy = DataModuleDestroy - Left = 505 - Top = 393 Height = 208 Width = 206 object FilterDatasource: TDataSource @@ -58,7 +56,7 @@ object acCustomReport: TacCustomReport PDFSettings.FontEncoding = feAnsi PDFSettings.ImageCompressionLevel = 25 PreviewFormSettings.WindowState = wsMaximized - PreviewFormSettings.ZoomSetting = zsPageWidth + PreviewFormSettings.ZoomSetting = zs100Percent RTFSettings.DefaultFont.Charset = DEFAULT_CHARSET RTFSettings.DefaultFont.Color = clWindowText RTFSettings.DefaultFont.Height = -13 @@ -73,7 +71,7 @@ object acCustomReport: TacCustomReport XLSSettings.Title = 'Report' Left = 128 Top = 96 - Version = '15.01' + Version = '15.0' mmColumnWidth = 188914 object Detail: TppDetailBand Background1.Brush.Style = bsClear From af4a07cc9a6b286d440528493fcf37f25026a8b7 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 31 May 2016 09:21:12 -0300 Subject: [PATCH 069/294] =?UTF-8?q?ticket=5Fid:=20#44745=20-=20Altera?= =?UTF-8?q?=C3=A7=C3=A3o=20para=20tratar=20quando=20inicializar=20o=20sist?= =?UTF-8?q?ema=20mas=20cancelar=20o=20Login.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.pas | 7 ++- Forms/osCustomMainFrm.pas | 65 ++++++++++++++------------- 2 files changed, 40 insertions(+), 32 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index a0e6468..609f05a 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -79,7 +79,7 @@ TacCustomSQLMainData = class(TDataModule) function GetNextSequence(Nome: string): integer; function GetServerDate: TDatetime; - function GetServerDatetime: TDatetime; + function GetServerDatetime(aConnection: TSQLConnection=nil): TDatetime; function InTransaction: boolean; procedure StartTransaction; procedure Commit; @@ -459,11 +459,14 @@ function TacCustomSQLMainData.GetServerDate: TDatetime; Result := StrToDatetime(FormatDatetime('dd/mm/yyyy', GetServerDatetime)); end; -function TacCustomSQLMainData.GetServerDatetime: TDatetime; +function TacCustomSQLMainData.GetServerDatetime(aConnection: TSQLConnection=nil): TDatetime; var Query: TosSQLQuery; begin Query := GetQuery; + if (aConnection <> nil) then + Query.SQLConnection := aConnection; + try with Query, Query.SQL do begin diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index fdd0b15..36f4701 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -313,42 +313,47 @@ constructor TosCustomMainForm.Create(AOwner: TComponent); Width := 0; Height := 0; Application.Terminate; + Application.ProcessMessages; end; - Grid.Align := alClient; - RelatPanel.Align := alClient; -//preparar a abertura dos reports -//verificar se vale a pena manter uma SQLConnection só para os relatórios - SQLConnection.Close; - with TStringList.Create do + if (not Application.Terminated) then begin - try - LoadFromFile('AppParams.ini'); - for i := 0 to Count - 1 do - begin - sName := Names[i]; - SQLConnection.Params.Values[sName] := Values[sName]; + Grid.Align := alClient; + RelatPanel.Align := alClient; + + //preparar a abertura dos reports + //verificar se vale a pena manter uma SQLConnection só para os relatórios + SQLConnection.Close; + with TStringList.Create do + begin + try + LoadFromFile('AppParams.ini'); + for i := 0 to Count - 1 do + begin + sName := Names[i]; + SQLConnection.Params.Values[sName] := Values[sName]; + end; + if SQLConnection.Params.Values['DataBaseMeta']<>'' then + SQLConnection.Params.Values['Database'] := + SQLConnection.Params.Values['DatabaseMeta']; + finally + Free; end; - if SQLConnection.Params.Values['DataBaseMeta']<>'' then - SQLConnection.Params.Values['Database'] := - SQLConnection.Params.Values['DatabaseMeta']; - finally - Free; end; - end; - //TTMCI - //para buscar os metadados dos filtros usar o SQLConnection de metadados - acCustomSQLMainData.FilterQuery.SQLConnection := acCustomSQLMainData.SQLConnectionMeta; - qry := acCustomSQLMainData.GetQuery; - try - qry.SQLConnection := acCustomSQLMainData.SQLConnectionMeta; - qry.SQL.Text := 'SELECT NAME FROM XFILTERDEF'; - qry.Open; - qry.First; - finally - FreeAndNil(qry); - acCustomSQLMainData.FilterQuery.SQLConnection := acCustomSQLMainData.SQLConnection; + //TTMCI + //para buscar os metadados dos filtros usar o SQLConnection de metadados + acCustomSQLMainData.FilterQuery.SQLConnection := acCustomSQLMainData.SQLConnectionMeta; + qry := acCustomSQLMainData.GetQuery; + try + qry.SQLConnection := acCustomSQLMainData.SQLConnectionMeta; + qry.SQL.Text := 'SELECT NAME FROM XFILTERDEF'; + qry.Open; + qry.First; + finally + FreeAndNil(qry); + acCustomSQLMainData.FilterQuery.SQLConnection := acCustomSQLMainData.SQLConnection; + end; end; end; From 14253e031fe7905ea4882877bad7fc9134d6076c Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 3 Jun 2016 14:54:54 -0300 Subject: [PATCH 070/294] =?UTF-8?q?ticket=5Fid:=20#44745=20-=20Tratamento?= =?UTF-8?q?=20do=20m=C3=A9todo=20clonardataset=20para=20campos=20TStringFi?= =?UTF-8?q?eld?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.pas | 23 ++++++++++++++++------- Lib/UtilsUnit.pas | 3 +++ 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 609f05a..5f983b0 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -85,7 +85,7 @@ TacCustomSQLMainData = class(TDataModule) procedure Commit; procedure Rollback; procedure CloseTransaction; - function GetNewID(nomeGenerator: String = ''): integer; + function GetNewID(nomeGenerator: String= ''; aConnection: TSQLConnection = nil): integer; function GetGeneratorValue(nomeGenerator: String): integer; procedure GetUserInfo(apelido: string); @@ -413,7 +413,7 @@ procedure TacCustomSQLMainData.Commit; SQLConnection.Commit(FTransactionDesc); end; -function TacCustomSQLMainData.GetNewID(nomeGenerator: String): integer; +function TacCustomSQLMainData.GetNewID(nomeGenerator: String= ''; aConnection: TSQLConnection = nil): integer; var v: variant; qryAux: TosSQLDataSet; @@ -423,11 +423,18 @@ function TacCustomSQLMainData.GetNewID(nomeGenerator: String): integer; // Se estourou a faixa, lê um novo HighValue if (FIDLowValue = 10) or (FIDHighValue = -1) then begin - v := prvFilter.GetIDHigh; - if v = NULL then - raise Exception.Create('Não conseguiu obter o ID do server para inclusão'); - FIDHighValue := v; - FIDLowValue := 0; + try + if (aConnection <> nil) then + FilterQuery.SQLConnection := aConnection; + + v := prvFilter.GetIDHigh; + if v = NULL then + raise Exception.Create('Não conseguiu obter o ID do server para inclusão'); + FIDHighValue := v; + FIDLowValue := 0; + finally + FilterQuery.SQLConnection := Self.SQLConnection; + end; end; Result := FIDHighValue * 10 + FIDLowValue; Inc(FIDLowValue); @@ -435,6 +442,8 @@ function TacCustomSQLMainData.GetNewID(nomeGenerator: String): integer; begin qryAux := GeTosSQLDataset; try + if (aConnection <> nil) then + qryAux.SQLConnection := aConnection; qryAux.CommandText := 'select gen_id('+nomeGenerator+', 1) from RDB$DATABASE'; qryAux.Open; result := qryAux.Fields[0].AsInteger; diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2a3ebe9..1d6ad85 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1123,7 +1123,10 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; + if (cdsOrigem.Fields[i] is TStringField) then + Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; + end; cdsDestino.Close; cdsDestino.CreateDataSet; From 7ace5afe4bbe96a7486d65869d718ae3dc6145b0 Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Thu, 16 Jun 2016 17:00:37 -0300 Subject: [PATCH 071/294] =?UTF-8?q?Centraliza=C3=A7=C3=A3o=20do=20Login?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomLoginFormUn.dfm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Forms/osCustomLoginFormUn.dfm b/Forms/osCustomLoginFormUn.dfm index c3f5af4..25a0e06 100644 --- a/Forms/osCustomLoginFormUn.dfm +++ b/Forms/osCustomLoginFormUn.dfm @@ -13,7 +13,7 @@ object osCustomLoginForm: TosCustomLoginForm Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False - Position = poDesktopCenter + Position = poScreenCenter OnCreate = FormCreate OnShow = FormShow PixelsPerInch = 96 From 4aec18c4a4e27b5a9f2eabe8ae2a81e2c3a6fa32 Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 8 Jul 2016 14:56:27 -0300 Subject: [PATCH 072/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20de=20conex=C3=A3o?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.dfm | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.dfm b/Datamodules/acCustomSQLMainDataUn.dfm index 977038a..6c43f09 100644 --- a/Datamodules/acCustomSQLMainDataUn.dfm +++ b/Datamodules/acCustomSQLMainDataUn.dfm @@ -31,25 +31,24 @@ object acCustomSQLMainData: TacCustomSQLMainData Top = 96 end object SQLConnection: TosSQLConnection - ConnectionName = 'IBLocal' + ConnectionName = 'IBConnection' DriverName = 'Interbase' LoginPrompt = False Params.Strings = ( - 'BlobSize=32' - 'CommitRetain=' - - 'Database=localhost:C:\projetos\clientes\labmaster\DB\cli\LabMast' + - 'er.GDB' 'DriverName=Interbase' - 'ErrorResourceFile=' - 'LocaleCode=' + 'Database=database.gdb' + 'RoleName=RoleName' + 'User_Name=sysdba' 'Password=masterkey' - 'RoleName=' 'ServerCharSet=' 'SQLDialect=3' - 'Interbase TransIsolation=' - 'User_Name=SYSDBA' - 'WaitOnLocks=') + 'ErrorResourceFile=' + 'LocaleCode=0000' + 'BlobSize=-1' + 'CommitRetain=False' + 'WaitOnLocks=True' + 'IsolationLevel=ReadCommitted' + 'Trim Char=False') Left = 100 Top = 80 end From 5eaf4c9088b5120c4ab23e265cb4f1d599f11cf5 Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Wed, 27 Jul 2016 14:41:44 -0300 Subject: [PATCH 073/294] Ticket_ID: #47781 - Criado constante FormOrigem --- Lib/UtilsUnit.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2a3ebe9..e71af45 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -9,6 +9,7 @@ interface osSQLConnection, osSQLQuery, WinSock; type + TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); varArrayOfcomps = array of TComponent; TFuncaoParametroGetDesc = function(const vValor : Variant) : string; From 517821fa34b6a0b7c5d1a9fd9f66cff7106b8ff3 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 9 Aug 2016 11:17:15 -0300 Subject: [PATCH 074/294] =?UTF-8?q?ticket=5Fid:=20#47269=20-=20Atualiza?= =?UTF-8?q?=C3=A7=C3=A3o=20da=20tabela=20Medico,=20corre=C3=A7=C3=B5es=20g?= =?UTF-8?q?erais=20quando=20requisi=C3=A7=C3=A3o=20for=20multiguias?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.pas | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 5f983b0..2f7a6a8 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -578,19 +578,22 @@ procedure TacCustomSQLMainData.RegisterRefreshTable(PTableName: string; procedure TacCustomSQLMainData.UpdateVersion(PTableName: string); var Query: TosSQLQuery; + _Versao: integer; begin Query := GetQuery; try - with Query, Query.SQL do - begin - Text := - 'UPDATE ' + - 'VersaoTabela ' + - 'SET Versao = Versao + 1' + - 'WHERE ' + - 'NomeTabela = ' + QuotedStr(PTableName); - ExecSql; - end; + Query.SQL.Text := Format('SELECT Versao FROM VersaoTabela WHERE nomeTabela = %s', [QuotedStr(PTableName)]); + Query.Open; + _Versao := 1; + if (not Query.IsEmpty) then + _Versao := Query.FieldByName('Versao').AsInteger + 1; + + Query.SQL.Text := Format( + 'UPDATE OR INSERT INTO ' + + ' VersaoTabela (nometabela, Versao) ' + + ' VALUES (%s, %d) ' + + ' MATCHING (nomeTabela) ', [QuotedStr(PTableName), _Versao]); + Query.ExecSql; finally FreeQuery(Query); end; From 8c1f23ea5c797a6e30b8191518ce56a6224463f6 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 13 Sep 2016 16:05:57 -0300 Subject: [PATCH 075/294] ticket_id: #49514 - Qualidade do PDF - UseJPEGCompression = False --- Report/acCustomReportUn.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index e318e97..b6986f7 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -9,7 +9,7 @@ interface ppModule, raCodMod, ppMemo, ppVar, ppBands, ppStrtch, ppSubRpt, ppCtrls, ppPrnabl, ppCache, ppDB, ppDBPipe, ppTypes, Forms, ppViewr, daSQl, daDataModule, daQueryDataView, TypInfo, Printers, - ppPDFDevice, ppPrintr, ppParameter, ppArchiv; + ppPDFDevice, ppPrintr, ppParameter, ppArchiv, System.Zlib; type TTipoAdendo = (taWHERE, taORDER); @@ -216,6 +216,7 @@ procedure TacCustomReport.Print(const PID: integer); end; FPDFDevice.FileName := FTextFileName; FPDFDevice.Publisher := Report.Publisher; + Report.PDFSettings.UseJPEGCompression := False; FPDFDevice.PDFSettings := Report.PDFSettings; end else if FPrintToStream then From f3f679ac54ba54426de0a4e4c57b8c28d01231c3 Mon Sep 17 00:00:00 2001 From: francisco Date: Tue, 20 Sep 2016 17:49:04 -0300 Subject: [PATCH 076/294] Merge branch 'develop' --- Datamodules/acCustomSQLMainDataUn.pas | 23 +++++++++++++---------- Forms/osCustomLoginFormUn.dfm | 2 +- Report/acCustomReportUn.pas | 3 ++- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 5f983b0..2f7a6a8 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -578,19 +578,22 @@ procedure TacCustomSQLMainData.RegisterRefreshTable(PTableName: string; procedure TacCustomSQLMainData.UpdateVersion(PTableName: string); var Query: TosSQLQuery; + _Versao: integer; begin Query := GetQuery; try - with Query, Query.SQL do - begin - Text := - 'UPDATE ' + - 'VersaoTabela ' + - 'SET Versao = Versao + 1' + - 'WHERE ' + - 'NomeTabela = ' + QuotedStr(PTableName); - ExecSql; - end; + Query.SQL.Text := Format('SELECT Versao FROM VersaoTabela WHERE nomeTabela = %s', [QuotedStr(PTableName)]); + Query.Open; + _Versao := 1; + if (not Query.IsEmpty) then + _Versao := Query.FieldByName('Versao').AsInteger + 1; + + Query.SQL.Text := Format( + 'UPDATE OR INSERT INTO ' + + ' VersaoTabela (nometabela, Versao) ' + + ' VALUES (%s, %d) ' + + ' MATCHING (nomeTabela) ', [QuotedStr(PTableName), _Versao]); + Query.ExecSql; finally FreeQuery(Query); end; diff --git a/Forms/osCustomLoginFormUn.dfm b/Forms/osCustomLoginFormUn.dfm index c3f5af4..25a0e06 100644 --- a/Forms/osCustomLoginFormUn.dfm +++ b/Forms/osCustomLoginFormUn.dfm @@ -13,7 +13,7 @@ object osCustomLoginForm: TosCustomLoginForm Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False - Position = poDesktopCenter + Position = poScreenCenter OnCreate = FormCreate OnShow = FormShow PixelsPerInch = 96 diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index e318e97..b6986f7 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -9,7 +9,7 @@ interface ppModule, raCodMod, ppMemo, ppVar, ppBands, ppStrtch, ppSubRpt, ppCtrls, ppPrnabl, ppCache, ppDB, ppDBPipe, ppTypes, Forms, ppViewr, daSQl, daDataModule, daQueryDataView, TypInfo, Printers, - ppPDFDevice, ppPrintr, ppParameter, ppArchiv; + ppPDFDevice, ppPrintr, ppParameter, ppArchiv, System.Zlib; type TTipoAdendo = (taWHERE, taORDER); @@ -216,6 +216,7 @@ procedure TacCustomReport.Print(const PID: integer); end; FPDFDevice.FileName := FTextFileName; FPDFDevice.Publisher := Report.Publisher; + Report.PDFSettings.UseJPEGCompression := False; FPDFDevice.PDFSettings := Report.PDFSettings; end else if FPrintToStream then From c3a4f17e5ee7f836225d43abe891a5dac18f646f Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Thu, 29 Sep 2016 07:48:41 -0300 Subject: [PATCH 077/294] =?UTF-8?q?Ticket=5FID:=20#50098=20Refatora=C3=A7?= =?UTF-8?q?=C3=A3o=20da=20fun=C3=A7=C3=A3o=20ConverteTextoRTF?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1c97457..874d829 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1029,14 +1029,17 @@ function ConverteTextoToRTF(Texto: string): string; ss: TStringStream; begin try - ss := TStringStream.Create(Texto); - form := TForm.Create(nil); - richEdit := TRichEdit.Create(form); - richEdit.Parent := form; - richEdit.Text:= Texto; - richEdit.PlainText := False; - richEdit.Lines.SaveToStream(ss); - Result := ss.DataString; + if not isRTFValue(Texto) then + begin + ss := TStringStream.Create(Texto); + form := TForm.Create(nil); + richEdit := TRichEdit.Create(form); + richEdit.Parent := form; + richEdit.Text:= Texto; + richEdit.PlainText := False; + richEdit.Lines.SaveToStream(ss); + Result := ss.DataString; + end; finally FreeAndNil(ss); FreeAndNil(richEdit); From 0c5d84ceeae9611d8905a65233bf3937ccae7384 Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Thu, 29 Sep 2016 07:59:05 -0300 Subject: [PATCH 078/294] =?UTF-8?q?Ticket=5FID:=20#50098=20Refatora=C3=A7?= =?UTF-8?q?=C3=A3o=20da=20fun=C3=A7=C3=A3o=20ConverteTextoRTF?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 874d829..38f9aac 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1028,9 +1028,9 @@ function ConverteTextoToRTF(Texto: string): string; richEdit: TRichEdit; ss: TStringStream; begin - try - if not isRTFValue(Texto) then - begin + if not isRTFValue(Texto) then + begin + try ss := TStringStream.Create(Texto); form := TForm.Create(nil); richEdit := TRichEdit.Create(form); @@ -1039,11 +1039,11 @@ function ConverteTextoToRTF(Texto: string): string; richEdit.PlainText := False; richEdit.Lines.SaveToStream(ss); Result := ss.DataString; + finally + FreeAndNil(ss); + FreeAndNil(richEdit); + FreeAndNil(form); end; - finally - FreeAndNil(ss); - FreeAndNil(richEdit); - FreeAndNil(form); end; end; From 53d8cf78032293259a990f7c16cda4bdfec88b4a Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Wed, 26 Oct 2016 10:38:40 -0200 Subject: [PATCH 079/294] =?UTF-8?q?Ticket=5FID:=20#51603=20-=20UtilsUnit?= =?UTF-8?q?=20cria=C3=A7=C3=A3o=20do=20ApenasNumeroEletras?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 38f9aac..595de8d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -96,6 +96,7 @@ function isRTFValue(vValor: Variant): Boolean; //{\rtf function getCampoSemRTF(const vValor : Variant):String; function FormataStringList(texto, delimitador: string): string; procedure TrimAppMemorySize; +function ApenasLetrasNumeros(nStr:String): String; implementation @@ -104,6 +105,17 @@ implementation const CSIDL_COMMON_APPDATA = $0023; + +function ApenasLetrasNumeros(nStr:String): String; +Var + I: Integer; +begin + Result := ''; + for I := 1 to Length(nStr) do + if nStr[I] in['0'..'9','a'..'z','A'..'Z',Chr(8)] then + Result := Result + nStr[I]; +end; + function FormataStringList(texto, delimitador: string): string; begin Result := '"' + StringReplace(texto, From 292466d6ca43388b406b4f6b772e45c724aa282f Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 11 Nov 2016 15:06:07 -0200 Subject: [PATCH 080/294] =?UTF-8?q?ticket=5Fid:=20#52313=20-=20Inclus?= =?UTF-8?q?=C3=A3o=20do=20m=C3=A9todo=20zeraEsquerda?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 595de8d..2d2d70e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -97,6 +97,7 @@ function getCampoSemRTF(const vValor : Variant):String; function FormataStringList(texto, delimitador: string): string; procedure TrimAppMemorySize; function ApenasLetrasNumeros(nStr:String): String; +function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; implementation @@ -1347,5 +1348,10 @@ procedure TrimAppMemorySize; Application.ProcessMessages; end; +function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; +begin + Result := Trim(Valor); + Result := DupeString('0',Tamanho - Length(Result)) + Result; +end; end. From 43d0ada6e98488639db54989a0327b5ebeb4cf43 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 17 Nov 2016 15:04:01 -0200 Subject: [PATCH 081/294] =?UTF-8?q?ticket=5Fid:=20#52314=20-=20Inclus?= =?UTF-8?q?=C3=A3o=20do=20m=C3=A9todo=20EspacoDireita?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2d2d70e..7032d36 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -98,6 +98,7 @@ function FormataStringList(texto, delimitador: string): string; procedure TrimAppMemorySize; function ApenasLetrasNumeros(nStr:String): String; function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; +function EspacoDireita(Valor: String; const Tamanho: Integer): String; implementation @@ -1354,4 +1355,15 @@ function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; Result := DupeString('0',Tamanho - Length(Result)) + Result; end; +function EspacoDireita(Valor: String; const Tamanho: Integer): String; +var + I : Integer ; +begin + Result := '' ; + Valor := Trim(Valor); + for I:=Length(Valor)+1 to Tamanho do + Result := Result + ' '; + Result := Valor + Result ; +end; + end. From 99f6bb72e0e66b5db81bbd136ed6ea0f14d9798c Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Tue, 29 Nov 2016 17:02:16 -0200 Subject: [PATCH 082/294] =?UTF-8?q?Ticket=5FID:=20#52732=20-=20parametriza?= =?UTF-8?q?ndo=20a=20hash=20para=20aumentar=20o=20digito=20no=20M=C3=A9tod?= =?UTF-8?q?o=20CalculaHash?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 7032d36..90d37d7 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -15,7 +15,7 @@ interface TFuncaoParametroGetDesc = function(const vValor : Variant) : string; THSHash = class - class function CalculaHash(conteudo: string): string; + class function CalculaHash(conteudo: string; pDig : Integer = 2): string; class function GeraHashPCMed(linha: string): string; end; @@ -980,7 +980,7 @@ function GetIPAddress: string; Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); end; -class function THSHash.CalculaHash(conteudo: string): string; +class function THSHash.CalculaHash(conteudo: string; pDig : Integer = 2): string; var sum, i : Integer; HFrame : string; @@ -990,7 +990,7 @@ class function THSHash.CalculaHash(conteudo: string): string; begin sum := sum + Ord(conteudo[i]); end; - HFrame := IntToHex(sum mod 256,2); + HFrame := IntToHex(sum mod 256,pDig); if (Length(HFrame) < 2) then HFrame := '0' + HFrame; From 50a485588f3a8e5728dbcb7cf5f9d5fd0eb207ac Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 2 Dec 2016 14:11:47 -0300 Subject: [PATCH 083/294] =?UTF-8?q?ticket=5Fid:=20#52270=20-=20packetrecor?= =?UTF-8?q?d=20-=20pagina=C3=A7=C3=A3o?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomMainFrm.dfm | 188 +++++++++++++++++++++++--------------- Forms/osCustomMainFrm.pas | 34 ++++++- 2 files changed, 144 insertions(+), 78 deletions(-) diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index d1b30b8..39e2fc8 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -8,7 +8,6 @@ inherited osCustomMainForm: TosCustomMainForm Menu = MainMenu Visible = True WindowState = wsMaximized - ExplicitTop = -30 ExplicitWidth = 1016 ExplicitHeight = 699 PixelsPerInch = 96 @@ -23,7 +22,7 @@ inherited osCustomMainForm: TosCustomMainForm DragKind = dkDock TabOrder = 0 object MainToolbar: TToolBar - Left = 14 + Left = 11 Top = 2 Width = 262 Height = 29 @@ -102,9 +101,9 @@ inherited osCustomMainForm: TosCustomMainForm end end object ConsultaPanel: TPanel - Left = 289 + Left = 286 Top = 2 - Width = 481 + Width = 656 Height = 48 Align = alTop BevelOuter = bvNone @@ -118,7 +117,7 @@ inherited osCustomMainForm: TosCustomMainForm Caption = 'Pesquisa:' end object EditarTodosButton: TSpeedButton - Left = 400 + Left = 568 Top = 4 Width = 81 Height = 22 @@ -126,6 +125,13 @@ inherited osCustomMainForm: TosCustomMainForm Flat = True OnClick = EditarTodosButtonClick end + object Label1: TLabel + Left = 324 + Top = 8 + Width = 30 + Height = 13 + Caption = 'Limite:' + end object tbrFilter: TToolBar Left = 284 Top = 0 @@ -166,13 +172,45 @@ inherited osCustomMainForm: TosCustomMainForm ViewDefault = 0 end object SearchEdit: TEdit - Left = 320 + Left = 488 Top = 4 Width = 73 Height = 21 TabOrder = 2 OnDblClick = SearchEditDblClick end + object edtLimit: TSpinEdit + Left = 359 + Top = 5 + Width = 55 + Height = 22 + MaxValue = 1000 + MinValue = 0 + TabOrder = 3 + Value = 1000 + end + object tbrSkip: TToolBar + Left = 424 + Top = 0 + Width = 29 + Height = 29 + Align = alNone + AutoSize = True + ButtonHeight = 29 + ButtonWidth = 29 + Caption = 'tbrSkip' + ParentShowHint = False + ShowHint = True + TabOrder = 4 + object SkipButton: TToolButton + Left = 0 + Top = 0 + Hint = 'Carrega os pr'#243'ximos registros' + Action = FilterAction + ImageIndex = 10 + OnClick = SkipButtonClick + end + end end end object StatusBar: TStatusBar [1] @@ -2048,7 +2086,7 @@ inherited osCustomMainForm: TosCustomMainForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 279401 PrinterSetup.mmPaperWidth = 215900 - PrinterSetup.PaperSize = 120 + PrinterSetup.PaperSize = 1 Template.DatabaseSettings.DataPipeline = plItem Template.DatabaseSettings.NameField = 'Name' Template.DatabaseSettings.TemplateField = 'Template' @@ -2121,7 +2159,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 674 Top = 52 Bitmap = { - 494C01010A000C003C0016001600FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01010B000C003C0016001600FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000058000000420000000100200000000000C05A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2129,9 +2167,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2140,9 +2178,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000000000000000000000000000000000000000 0000CEBDB500AD7B73008C3931007B1810006B00000063000000731010008431 3100A5737300C6BDB50000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2151,9 +2189,9 @@ inherited osCustomMainForm: TosCustomMainForm 000000000000000000000000000000000000000000000000000000000000B584 73008418100084100800B5421800D66B2900DE733100DE733100CE6B2900A539 18006B0000006B080800A5737300000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF99BA + D700709FE1005C97E700328CFF00328CFF005D98E800709FE1008DAFD100FFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2162,9 +2200,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000000000000000000000000000A55A4A008C21 0800BD521800FF943900FF943900FF943900FF943900FF943900FF943900FF94 3900FF943900B54218006B0000008C4239000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBBCAD3004492 + E500318EFF003893FF004CA5FF004DA6FF003994FF00318DFF004595E200AFBD + D900FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2173,9 +2211,9 @@ inherited osCustomMainForm: TosCustomMainForm 00000000000000000000000000000000000000000000A5634A0094290800E77B 2100FF8C2900FF8C2900FF8C2900FF8C2900FF8C2900FF8C2900FF8C2900FF8C 2900FF8C2900FF8C2900E76B21006B0000008C42390000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAFC0D7005C9DDA004999 + FF004D90FF004588FD00387AFD00397BFF004487FC00498CFB004F9FFF005094 + E1009DB9D400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2184,9 +2222,9 @@ inherited osCustomMainForm: TosCustomMainForm 000000000000000000000000000000000000BD8C7B0094290800EF731000FF84 1800FF841800FF841800FF841800FF841800FF841800FF841800FF841800FF84 1800FF841800FF841800FF841800E76B10006B000000A5737300000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0CCE400669EE3003493FF004386 + FB003781FF00377EFF003D7BFF003F7DFF00387FFF00357FFF004582FA003192 + FF00569BE500A7C0DE00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2195,9 +2233,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000CEC6B5009C391800CE520800FF7B0800FF7B 0800FF943100FFDEBD00FFDEBD00FFDEBD00FFDEBD00FFDEBD00FFDEBD00FFDE BD00FFDEBD00FFA55200FF7B0800FF7B0800B53100006B080800C6BDB5000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF71A7E4003A91F0003D91FF003780 + FF003D7FFF003C86FF004398FD00469BFF00418BFF003F81FF003A80FF003788 + FF003790FF005AA2E400FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2206,9 +2244,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000BD947B00A5391000FF730000FF730000FF73 0000FFBD7300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFBD7300FF730000FF730000FF7300006B000000A57373000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF3591FF003C84F4003788FF00348E + FF00458EFC002E85FF00F0FDFF00F9FFFF00F7FFFF0050A8F3002D94FF003984 + FF004C8FFC003187F500E4DDE400FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2217,9 +2255,9 @@ inherited osCustomMainForm: TosCustomMainForm BD00000000000000000000000000AD634200CE520800FF730000FF7B0000FF73 0000FFBD7300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFBD7300FF730000FF730000FF730000A5290000843131000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFC8D5E5003588FF00398EFA003E99FF003795 + F700388BFB00579CF7004B94FB00F2F5FF00F2FAFF00FBFFF90056B2FB004492 + FF003B8EF8003E91FF0093BCEB00FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2228,9 +2266,9 @@ inherited osCustomMainForm: TosCustomMainForm AD00000000000000000000000000AD522900E7630000FF7B0000FF7B0000FF7B 0000FFBD7B00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFBD7300FF7B0000FF7B0000FF7B0000CE4A0000731010000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFF92BFE100328AFF003897FF00429DFC0072B2 + F30059B8F40037ADFE00499BFA005095ED00F7FBFF00FFFCFF00E8F7FF0040A4 + FE003E92F4003199FF0063AAFC00FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2239,9 +2277,9 @@ inherited osCustomMainForm: TosCustomMainForm AD00000000000000000000000000AD421000EF731000FF8C1800FF8C1800FF9C 3100FFE7C600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFDEBD00FF9C3100FF7B0000FF7B0000DE5A0000630000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFF6EB5E9003D9BFF00419AFF0049AAFC00E7F4 + FF00F3FFFF00FAF7FF00F3F7FF00FFFAFC00FFFFF600EFFDFC00FFFFF60052AF + F50048A2F700479FFF005BA7EE00FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2250,9 +2288,9 @@ inherited osCustomMainForm: TosCustomMainForm BD00000000000000000000000000AD4A1800EF7B1000FF9C3100FF9C3100F7D6 C600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFF7EF00FF7B0000FF7B0000DE5A0000630000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFF6BB1F1004BA4FD0044A4FE0048AFFC00FFFD + FA00FFFCFD00F8FCFD00F1FBFF00FAFBFF00FCFFFF00FFFFF000F5FFFF00F0FC + FF0032A5FE003A9BFF00459FF400FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2261,9 +2299,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000B55A2900E7731800FFA55200FFA55200EFAD 7B00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00F7AD6300FF7B0000FF7B0000D6520000731010000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFF77BDF9004BA3FF003AB0FE004CA2F300F6FB + FA00FFFCFF00FAFFFF00FFFFF300FFF8F900FFF9FF00FFFFFB00FFF7FF004CB2 + F1002FA5FD0048ADFE005CA3F300FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2272,9 +2310,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000BD734A00D6630800FFB56300FFB56B00FFB5 6B00EFA56B00F7EFE700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00F7C69400FFA54200FF8C1800FF7B0000AD3100008C3931000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFB4D9FF003CAEFE0042ACF80043ACFE0055AE + FD0042AAFB0040A9FE0046AEFE0056B8EC00FFFFFD00FFFFFA00F0F7FF003EAE + FE004CADF50036AFFE0091C6FD00FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2283,9 +2321,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000C69C7B00B5521800FFA54200FFC68400FFC6 8400FFC68400F7B57B00EFCEBD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFD6A500FFC68400FFC68400FFAD52007B100000AD7B73000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFD0EFFF003EB1FE0041AFFE003BB2F8003AAF + F7003EB2F3004DB8FE0049B6F400EDF9FD00F5FFFF00EAFAFF0054B8F6003AB2 + FD0049B5FE004CAFFE00B7E3FF00FFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2294,9 +2332,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000CEC6B500B55A2100DE6B1000FFCE9400FFD6 A500FFD6A500FFD6A500FFCE9C00E7BD9C00FFF7EF00FFFFFF00FFDECE00FFEF D600FFEFD600FFD6AD00FFD6A500FFD6A500BD5218007B100800CEBDB5000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5BBBF50037B0FE004FBDFE0047B7 + FE0037ADFE0053C1FE00CDEBFF00FFFDFF004EC1F90048B6FE0042B7FE0059C3 + F9003ABAFE0040B4FE00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2305,9 +2343,9 @@ inherited osCustomMainForm: TosCustomMainForm 000000000000000000000000000000000000C69C8400BD521800F7842100FFDE AD00FFDEBD00FFDEBD00FFDEBD00FFDEBD00EFBD9C00F7CEAD00FFDEBD00FFDE BD00FFDEBD00FFDEBD00FFDEBD00E78C390084180000AD847300000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBBDFFF0053BBF8002EB2FB0042C2 + FE005BC5FE002CB6FA004CBDF40056BCEF004BBEF60039BDFE0040BEFD003DC2 + FD003BBCFC009CD5F900FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2316,9 +2354,9 @@ inherited osCustomMainForm: TosCustomMainForm 00000000000000000000000000000000000000000000BD845200BD521800F784 2100FFDEB500FFEFD600FFEFD600FFEFD600FFEFD600FFEFD600FFEFD600FFEF D600FFEFD600FFE7C600E79442008C2108009C52420000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4DCFB004AC4FB003EC6 + FE004BC2FC003BC6F90030C7FE003AC3FE004BC5FE0053C6F70047C8FE0035C0 + F80087DBF900FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2327,9 +2365,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000000000000000000000000000BD845200BD52 1800DE6B1000FFB56B00FFE7CE00FFF7EF00FFF7EF00FFF7EF00FFF7EF00FFEF DE00FFC68C00C65A180094290800A55A4A000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB6ECFE0051C1 + F3003CCBFE0060D2FE0056D1FE004AC7FE004BC6FE004FD3FE003EC3F2008EDB + F600FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2338,9 +2376,9 @@ inherited osCustomMainForm: TosCustomMainForm 000000000000000000000000000000000000000000000000000000000000C69C 7B00B55A2100B5521000D65A0800E77B1800EF8C3900E78C3900DE7B2900C652 08009C31080094311000B58C7B00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF84DE + FE0041CBFE0039C1FE003DC6FE003EC8F8003BC8F6002ECBFE0086DAFE00FFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2349,6 +2387,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000000000000000000000000000000000000000 0000CEC6B500C69C7B00BD734A00AD522900A5421000A5391000A54A2100AD63 4200BD8C7B00CEBDB50000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2357,12 +2398,9 @@ inherited osCustomMainForm: TosCustomMainForm 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2876,7 +2914,7 @@ inherited osCustomMainForm: TosCustomMainForm 00080003C0003F0080003C0000080003C0003F0080003C0000080003C0007F00 80003C0000080003C0007F0080007C0000080007C0007F008000FC000008000F C000FF008001FC000008001FE000FF008003FC000008003FF001FF008007FC00 - 0008007FF807FF0000000000000000000000000000000000000000000000} + 0008007FF807FF00} end object SQLConnection: TSQLConnection ConnectionName = 'IBLocal' diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 36f4701..1dbe404 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -16,7 +16,7 @@ interface ppModule, daDataModule, FMTBcd, osCustomDataSetProvider, osSQLDataSetProvider, daSQl, daQueryDataView, ppTypes, acCustomReportUn, osSQLQuery, acFilterController, CommCtrl, clipbrd, osCustomLoginFormUn, - acReportContainer, ppParameter, Data.DBXInterBase, System.Actions; + acReportContainer, ppParameter, Data.DBXInterBase, System.Actions, Vcl.Samples.Spin; type TDatamoduleClass = class of TDatamodule; @@ -143,6 +143,10 @@ TosCustomMainForm = class(TosForm) TreeView1: TTreeView; EdtPesquisa: TEdit; Splitter1: TSplitter; + edtLimit: TSpinEdit; + Label1: TLabel; + tbrSkip: TToolBar; + SkipButton: TToolButton; procedure EditActionExecute(Sender: TObject); procedure ViewActionExecute(Sender: TObject); procedure NewActionExecute(Sender: TObject); @@ -197,7 +201,9 @@ TosCustomMainForm = class(TosForm) procedure TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); procedure EdtPesquisaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure SkipButtonClick(Sender: TObject); private + FSkip: Boolean; FNewFilter: boolean; FUserName: string; FEditForm: TosCustomEditForm; @@ -541,8 +547,17 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); var sent: string; data: oleVariant; + NewFilter : Boolean; begin inherited; + NewFilter := False; + if TComponent(Sender).Name <> 'SkipButton' then + begin + FSkip := False; + NewFilter := True; + //SkipButton.Enabled := True; + //Edtlimit.Enabled := True; + end; data := FilterDataset.data; FModifiedList.Clear; if Assigned(FCurrentResource) then @@ -553,13 +568,19 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); ReplaceReportSQLPrint else begin - sent := ConsultaCombo.ExecuteFilter; + sent := ConsultaCombo.ExecuteFilter(NewFilter, Edtlimit.Value, FSkip); if sent = '' then begin FilterDataset.data := data; ConsultaCombo.ConfigFields(ConsultaCombo.ItemIndex); end; end; + {if FilterDataset.RecordCount <= edtLimit.Value then + begin + SkipButton.Enabled := False; + Edtlimit.Enabled := False; + end;} + FIDField := FilterDataset.Fields.FindField('ID'); CheckMultiSelection; @@ -583,7 +604,7 @@ procedure TosCustomMainForm.ExecLastFilter; Screen.Cursor := crHourglass; try FilterDataset.Close; - ConsultaCombo.ExecuteFilter(FNewFilter); + ConsultaCombo.ExecuteFilter(FNewFilter, edtLimit.Value, FSkip); FNewFilter := false; FIDField := FilterDataset.Fields.FindField('ID'); CheckMultiSelection; @@ -726,6 +747,13 @@ procedure TosCustomMainForm.ShowQueryActionExecute(Sender: TObject); ShowQueryAction.Checked := not ShowQueryAction.Checked; end; +procedure TosCustomMainForm.SkipButtonClick(Sender: TObject); +begin + inherited; + FSkip := True; + FilterActionExecute(SkipButton); +end; + procedure TosCustomMainForm.ResourceClick(Sender: TObject); var NewResource: TosAppResource; From d511239adbb14a0afa6136688250e4a5f307e649 Mon Sep 17 00:00:00 2001 From: francisco Date: Wed, 21 Dec 2016 17:09:43 -0200 Subject: [PATCH 084/294] ValueIsEmptyNull --- Lib/UtilsUnit.pas | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 90d37d7..f6b36b3 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1076,7 +1076,14 @@ function FieldHasChanged(aField : TField):Boolean; function ValueIsEmptyNull(aValue : Variant):Boolean; begin - Result := VarIsEmpty(aValue) or VarIsNull(aValue) or (VarToStr(aValue) = EmptyStr); + Result := VarIsEmpty(aValue) or VarIsNull(aValue); + + if not Result then + try + Result := Trim(varToStr(aValue)) = EmptyStr + except + Result := False; + end; end; function getDescricaoSexo(const vValor : Variant):String; From 187b0e5ef709f42150442a683245db0f96219bf3 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 22 Dec 2016 08:20:48 -0200 Subject: [PATCH 085/294] Ajustes no ValueEmptyIsNull --- Lib/UtilsUnit.pas | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index f6b36b3..a9b2506 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1078,12 +1078,8 @@ function ValueIsEmptyNull(aValue : Variant):Boolean; begin Result := VarIsEmpty(aValue) or VarIsNull(aValue); - if not Result then - try - Result := Trim(varToStr(aValue)) = EmptyStr - except - Result := False; - end; + if (not Result) and VarIsStr(aValue) then + Result := Trim(varToStr(aValue)) = EmptyStr end; function getDescricaoSexo(const vValor : Variant):String; From 35add8d2b1dd31c03ddab070d07a9cc0d03e28f5 Mon Sep 17 00:00:00 2001 From: Claudio <------@labplus.com.br> Date: Wed, 28 Dec 2016 08:39:06 -0200 Subject: [PATCH 086/294] =?UTF-8?q?Ticket=5FID:=20#54160=20-=20Corre=C3=A7?= =?UTF-8?q?=C3=A3o=20no=20encode=20da=20gera=C3=A7=C3=A3o=20de=20pdf?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Report/acCustomReportUn.dfm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Report/acCustomReportUn.dfm b/Report/acCustomReportUn.dfm index 4369d2f..0b232f3 100644 --- a/Report/acCustomReportUn.dfm +++ b/Report/acCustomReportUn.dfm @@ -53,7 +53,7 @@ object acCustomReport: TacCustomReport PDFSettings.EncryptSettings.AllowPrint = True PDFSettings.EncryptSettings.Enabled = False PDFSettings.EncryptSettings.KeyLength = kl40Bit - PDFSettings.FontEncoding = feAnsi + PDFSettings.FontEncoding = feUnicode PDFSettings.ImageCompressionLevel = 25 PreviewFormSettings.WindowState = wsMaximized PreviewFormSettings.ZoomSetting = zs100Percent From 8f1f4be2e1523c8b6be5026aa22979fb929771f9 Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 30 Dec 2016 15:26:41 -0200 Subject: [PATCH 087/294] =?UTF-8?q?Ticket=5FID:=20#54160=20-=20Corre=C3=A7?= =?UTF-8?q?=C3=A3o=20no=20encode=20da=20gera=C3=A7=C3=A3o=20de=20pdf?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Report/acCustomReportUn.dfm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Report/acCustomReportUn.dfm b/Report/acCustomReportUn.dfm index 4369d2f..0b232f3 100644 --- a/Report/acCustomReportUn.dfm +++ b/Report/acCustomReportUn.dfm @@ -53,7 +53,7 @@ object acCustomReport: TacCustomReport PDFSettings.EncryptSettings.AllowPrint = True PDFSettings.EncryptSettings.Enabled = False PDFSettings.EncryptSettings.KeyLength = kl40Bit - PDFSettings.FontEncoding = feAnsi + PDFSettings.FontEncoding = feUnicode PDFSettings.ImageCompressionLevel = 25 PreviewFormSettings.WindowState = wsMaximized PreviewFormSettings.ZoomSetting = zs100Percent From da992b6d363ed4ada9715b89a235f294c1df8bfa Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 2 Jan 2017 10:58:46 -0200 Subject: [PATCH 088/294] =?UTF-8?q?Ticket=5FID:=20#54331=20-=20erro=20ao?= =?UTF-8?q?=20editar=20registro=20com=20n=C3=BAmero=20de=20protocolo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomEditFrm.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index f4beaa9..6bf4b5e 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -72,13 +72,13 @@ TosCustomEditForm = class(TosForm) procedure SetExternalCDS(const Value: TosClientDataset); procedure SetDatamodule(const Value: TDatamodule); function GetKeyValues: Variant; - procedure ControlButtons; protected FMasterDataset: TosClientDataset; FKeyValues: variant; FFormMode: TFormMode; FExternalCDS: TosClientDataset; FIsModified: boolean; + procedure ControlButtons; procedure MasterDatasetAfterEdit(DataSet: TDataSet); virtual; procedure CheckMasterDataset; procedure Loaded; override; From df8f460603f02700c506877c383e3098d1a2e352 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 12 Jan 2017 10:19:33 -0200 Subject: [PATCH 089/294] Ticket_ID: #53231 - Mergear o Branch Correcao_Transactions no Master MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit #54043 - Transações implícitas abertas e nunca fechadas --- Datamodules/acCustomSQLMainDataUn.pas | 27 ++++++++++++--------------- Forms/osCustomEditFrm.dfm | 2 +- Forms/osCustomEditFrm.pas | 2 +- 3 files changed, 14 insertions(+), 17 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 2f7a6a8..72d3f2d 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -6,7 +6,7 @@ interface SysUtils, Classes, Data.DBXFirebird, FMTBcd, SqlExpr, osSQLDataSet, DB, osSQLConnection, Provider, osCustomDataSetProvider, osSQLDataSetProvider, DBTables, osClientDataSet, Contnrs, osSQLQuery, Forms, Types, Variants, - Data.DBXInterBase; + Data.DBXInterBase, Data.DBXCommon; const @@ -81,9 +81,9 @@ TacCustomSQLMainData = class(TDataModule) function GetServerDate: TDatetime; function GetServerDatetime(aConnection: TSQLConnection=nil): TDatetime; function InTransaction: boolean; - procedure StartTransaction; - procedure Commit; - procedure Rollback; + function StartTransaction: TDBXTransaction; + procedure Commit(var Transaction: TDBXTransaction); + procedure Rollback(var Transaction: TDBXTransaction); procedure CloseTransaction; function GetNewID(nomeGenerator: String= ''; aConnection: TSQLConnection = nil): integer; function GetGeneratorValue(nomeGenerator: String): integer; @@ -405,12 +405,12 @@ function TacCustomSQLMainData.GetQuery(meta: boolean): TosSQLQuery; procedure TacCustomSQLMainData.FreeQuery(Query: TosSQLQuery); begin Query.Close; - Query.Destroy; + FreeAndNil(Query); end; -procedure TacCustomSQLMainData.Commit; +procedure TacCustomSQLMainData.Commit(var Transaction: TDBXTransaction); begin - SQLConnection.Commit(FTransactionDesc); + SQLConnection.CommitFreeAndNil(Transaction); end; function TacCustomSQLMainData.GetNewID(nomeGenerator: String= ''; aConnection: TSQLConnection = nil): integer; @@ -523,19 +523,16 @@ function TacCustomSQLMainData.InTransaction: boolean; Result := SQLConnection.InTransaction; end; -procedure TacCustomSQLMainData.Rollback; +procedure TacCustomSQLMainData.RollBack(var Transaction: TDBXTransaction); begin - SQLConnection.Rollback(FTransactionDesc); + SQLConnection.RollbackFreeAndNil(Transaction); end; -procedure TacCustomSQLMainData.StartTransaction; +function TacCustomSQLMainData.StartTransaction: TDBXTransaction; begin + Result := nil; if not SQLConnection.InTransaction then - begin - FTransactionDesc.TransactionID := 1; - FTransactionDesc.IsolationLevel := xilREADCOMMITTED; - SQLConnection.StartTransaction(FTransactionDesc); - end; + Result := SQLConnection.BeginTransaction(TDBXIsolations.ReadCommitted); end; procedure TacCustomSQLMainData.CloseTransaction; diff --git a/Forms/osCustomEditFrm.dfm b/Forms/osCustomEditFrm.dfm index 8f88d38..3397fd9 100644 --- a/Forms/osCustomEditFrm.dfm +++ b/Forms/osCustomEditFrm.dfm @@ -168,7 +168,7 @@ inherited osCustomEditForm: TosCustomEditForm Left = 216 Top = 40 Bitmap = { - 494C0101010004000C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010101000400100010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index f4beaa9..a6c3908 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -72,7 +72,6 @@ TosCustomEditForm = class(TosForm) procedure SetExternalCDS(const Value: TosClientDataset); procedure SetDatamodule(const Value: TDatamodule); function GetKeyValues: Variant; - procedure ControlButtons; protected FMasterDataset: TosClientDataset; FKeyValues: variant; @@ -87,6 +86,7 @@ TosCustomEditForm = class(TosForm) procedure ChangeColor(PReadOnly: boolean); procedure ReconcileError(DataSet: TCustomClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction); + procedure ControlButtons; public continue: boolean; constructor Create(AOwner: TComponent); override; From 02a0fe6c445343f81261aefb00979cf2d1271e0f Mon Sep 17 00:00:00 2001 From: Fabiano Passianoto Date: Fri, 27 Jan 2017 09:21:18 -0200 Subject: [PATCH 090/294] Ticket_ID: #54132 - Incluido campo LIMITE, em cada Filtro. --- Datamodules/FilterDefDataUn.dfm | 9 +- Forms/FilterDefEditFormUn.dfm | 204 +++++++++++++++++++++++++++++++- Forms/FilterDefEditFormUn.pas | 6 +- 3 files changed, 208 insertions(+), 11 deletions(-) diff --git a/Datamodules/FilterDefDataUn.dfm b/Datamodules/FilterDefDataUn.dfm index ee78c60..abb1371 100644 --- a/Datamodules/FilterDefDataUn.dfm +++ b/Datamodules/FilterDefDataUn.dfm @@ -1,8 +1,6 @@ object FilterDefData: TFilterDefData OldCreateOrder = False OnCreate = DataModuleCreate - Left = 379 - Top = 262 Height = 376 Width = 569 object MasterDatasource: TDataSource @@ -19,7 +17,7 @@ object FilterDefData: TFilterDefData object MasterDataset: TosSQLDataSet CommandText = 'SELECT'#13#10' IDXFilterDef,'#13#10' Name,'#13#10' FilterType,'#13#10' Titulo'#13#10'FROM'#13 + - #10' XFilterDef'#13#10'WHERE'#13#10' IDXFilterDef = :ID'#13#10 + #10' XFilterDef'#13#10'WHERE'#13#10' IDXFilterDef = :ID' MaxBlobSize = 32 Params = < item @@ -36,8 +34,9 @@ object FilterDefData: TFilterDefData CommandText = 'SELECT'#13#10' IDXFilterDefDetail,'#13#10' IDXFilterDef,'#13#10' Number,'#13#10' Des' + 'cription,'#13#10' QueryText,'#13#10' AttributeList,'#13#10' ExpressionList,'#13#10' ' + - 'ConstraintList,'#13#10' OrderList,'#13#10' OrderColumn,'#13#10' OrderType'#13#10'FROM' + - #13#10' XFilterDefDetail'#13#10'WHERE'#13#10' IDXFilterDef = :IDXFilterDef'#13#10 + 'ConstraintList,'#13#10' OrderList,'#13#10' OrderColumn,'#13#10' OrderType,'#13#10' L' + + 'imite'#13#10'FROM'#13#10' XFilterDefDetail'#13#10'WHERE'#13#10' IDXFilterDef = :IDXFil' + + 'terDef' DataSource = MasterDatasource MaxBlobSize = 32 Params = < diff --git a/Forms/FilterDefEditFormUn.dfm b/Forms/FilterDefEditFormUn.dfm index c0dcdff..d76a251 100644 --- a/Forms/FilterDefEditFormUn.dfm +++ b/Forms/FilterDefEditFormUn.dfm @@ -1,12 +1,14 @@ inherited FilterDefEditForm: TFilterDefEditForm Left = 492 Top = 121 - Width = 520 - Height = 568 ActiveControl = DBEdit2 BorderIcons = [biSystemMenu, biMinimize] BorderWidth = 4 Caption = 'Defini'#231#227'o de Filtros' + ClientHeight = 501 + ClientWidth = 496 + ExplicitWidth = 520 + ExplicitHeight = 568 PixelsPerInch = 96 TextHeight = 13 object Label1: TLabel [0] @@ -48,8 +50,9 @@ inherited FilterDefEditForm: TFilterDefEditForm Caption = 'T'#237'tulo:' end inherited MainControlBar: TControlBar - Width = 504 + Width = 496 TabOrder = 4 + ExplicitWidth = 496 end object DBEdit2: TDBEdit [6] Left = 48 @@ -115,7 +118,7 @@ inherited FilterDefEditForm: TFilterDefEditForm Top = 272 Width = 490 Height = 195 - ActivePage = TabSheet5 + ActivePage = Tblimite Anchors = [akLeft, akRight, akBottom] TabOrder = 3 object TabSheet1: TTabSheet @@ -261,6 +264,26 @@ inherited FilterDefEditForm: TFilterDefEditForm ValueUnchecked = 'A' end end + object Tblimite: TTabSheet + Caption = '&Limite' + ImageIndex = 5 + object Label7: TLabel + Left = 11 + Top = 24 + Width = 30 + Height = 13 + Caption = 'Limite:' + end + object EdLimite: TDBEdit + Left = 48 + Top = 20 + Width = 107 + Height = 21 + DataField = 'LIMITE' + DataSource = dsEditDetail + TabOrder = 0 + end + end end object csTeste: TosComboSearch [10] Left = 11 @@ -358,6 +381,145 @@ inherited FilterDefEditForm: TFilterDefEditForm end inherited ImageList: TImageList Left = 276 + Bitmap = { + 494C0101010004001C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001002000000000000010 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000C6C6BD00BDB5AD009C9C94008C84 + 84008C8484008C8484008C8484008C8484008C8484008C8484008C8484008C84 + 84008C84840094948C00B5ADA500000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000063312900633129006331 + 2900633129006331290063312900633129006331290063312900633129006331 + 2900633129007B73730094948C00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00AD847300DEB5A500DEB5 + A500D6ADA500D6AD9C00CEA59C00CE9C9400CE9C8C00C6948C00C6948400C694 + 84008C524200633129008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00B58C7B00FFF7F700FFF7 + F700F7EFEF00F7EFE700EFDED600DEC6B500DEBDAD00D6B5A500D6B5A500DEB5 + A5008C524200633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00B58C7B00FFF7F700DEDE + D600DED6CE00DECEC600DECEBD00D6BDAD00CEB5A500CEAD9C00C6A59400DEBD + AD008C524200633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00BD948400FFF7F700FFF7 + F700F7F7EF00F7EFEF00F7EFE700EFE7DE00E7D6CE00DEBDAD00D6BDAD00DEBD + B5008C524200633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00BD9C8400FFF7F700FFF7 + F700FFF7F700F7F7EF00F7EFEF00F7EFE700EFE7DE00DEC6BD00DEC6B500E7CE + BD008C5A4200633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00C69C8C00FFFFF700FFFF + F700FFF7F700FFF7F700F7F7EF00F7EFE700F7EFE700EFD6CE00EFD6C600E7D6 + C600945A4200633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00C6A59400C6A59400C69C + 8C00BD948400BD948400BD947B00B58C7B00B5847300AD7B6B009C634A00945A + 4A00945A4A00633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00CEAD9C00C6A59400C6A5 + 9400BD9C8C00BD9C8400BD948400B58C7B00B58C7B00AD8473009C6352009C63 + 4A00945A4A00633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C635A00CEAD9C00CEAD9C00C6A5 + 9400C6A58C00BD9C8C00BD9C8400BD947B00B58C7B00B5847300AD7B6B009C63 + 5200945A4A00633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008C6B5A00D6B5A500FFFFFF009C63 + 4A00D6BDAD00FFFFFF00FFFFFF00FFFFFF00FFFFF700FFEFEF00F7EFE700F7E7 + DE009C635200633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000946B5A00D6BDAD00FFFFFF009C63 + 4A00D6BDAD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF7F700FFF7EF00FFEF + EF00A56B5A00633121008C848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000946B5A00D6BDB500FFFFFF009C63 + 4A009C634A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFF700FFF7 + F700B58473006331290094948C00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000946B5A00946B5A008C6B + 5A008C635A008C635A008C635A008C6352008C6352008C6352008C6352008C5A + 5200845A5200BDBDB500CEC6BD00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF00FFFF0000000000000001000000000000 + 8001000000000000000100000000000000010000000000000001000000000000 + 0001000000000000000100000000000000010000000000000001000000000000 + 0001000000000000000100000000000000010000000000000001000000000000 + 0001000000000000800100000000000000000000000000000000000000000000 + 000000000000} end inherited MainMenu: TMainMenu Left = 240 @@ -467,6 +629,9 @@ inherited FilterDefEditForm: TFilterDefEditForm FixedChar = True Size = 1 end + object cdsEditDetailLIMITE: TIntegerField + FieldName = 'LIMITE' + end end object dsEditDetail: TDataSource DataSet = cdsEditDetail @@ -506,6 +671,7 @@ inherited FilterDefEditForm: TFilterDefEditForm PrinterSetup.DocumentName = 'Report' PrinterSetup.PaperName = 'A4 (210 x 297 mm)' PrinterSetup.PrinterName = 'Default' + PrinterSetup.SaveDeviceSettings = False PrinterSetup.mmMarginBottom = 6350 PrinterSetup.mmMarginLeft = 6350 PrinterSetup.mmMarginRight = 6350 @@ -513,18 +679,46 @@ inherited FilterDefEditForm: TFilterDefEditForm PrinterSetup.mmPaperHeight = 297000 PrinterSetup.mmPaperWidth = 210000 PrinterSetup.PaperSize = 9 + ArchiveFileName = '($MyDocuments)\ReportArchive.raf' DeviceType = 'Screen' + DefaultFileDeviceType = 'PDF' EmailSettings.ReportFormat = 'PDF' + LanguageID = 'Default' OnPreviewFormCreate = ReportPreviewFormCreate + OpenFile = False OutlineSettings.CreateNode = True OutlineSettings.CreatePageNodes = True OutlineSettings.Enabled = False OutlineSettings.Visible = False + ThumbnailSettings.Enabled = True + ThumbnailSettings.Visible = True + ThumbnailSettings.DeadSpace = 30 + PDFSettings.EmbedFontOptions = [efUseSubset] + PDFSettings.EncryptSettings.AllowCopy = True + PDFSettings.EncryptSettings.AllowInteract = True + PDFSettings.EncryptSettings.AllowModify = True + PDFSettings.EncryptSettings.AllowPrint = True + PDFSettings.EncryptSettings.Enabled = False + PDFSettings.EncryptSettings.KeyLength = kl40Bit + PDFSettings.FontEncoding = feAnsi + PDFSettings.ImageCompressionLevel = 25 + RTFSettings.DefaultFont.Charset = DEFAULT_CHARSET + RTFSettings.DefaultFont.Color = clWindowText + RTFSettings.DefaultFont.Height = -13 + RTFSettings.DefaultFont.Name = 'Arial' + RTFSettings.DefaultFont.Style = [] + TextFileName = '($MyDocuments)\Report.pdf' TextSearchSettings.DefaultString = '' TextSearchSettings.Enabled = False + XLSSettings.AppName = 'ReportBuilder' + XLSSettings.Author = 'ReportBuilder' + XLSSettings.Subject = 'Report' + XLSSettings.Title = 'Report' Left = 256 Top = 460 - Version = '10.07' + Version = '15.0' mmColumnWidth = 0 + object ppParameterList1: TppParameterList + end end end diff --git a/Forms/FilterDefEditFormUn.pas b/Forms/FilterDefEditFormUn.pas index 777ccb0..4dcc63d 100644 --- a/Forms/FilterDefEditFormUn.pas +++ b/Forms/FilterDefEditFormUn.pas @@ -9,7 +9,7 @@ interface wwdbedit, Wwdotdot, Wwdbcomb, Menus, ImgList, osActionList, ToolWin, Buttons, ExtCtrls, osComboSearch, osUtils, osSQLDataSet, ppReport, daDataModule, daQueryDataView, ppTypes, daSQL, ppClass, ppComm, ppRelatv, - ppProd; + ppProd, ppParameter, System.Actions; type TFilterDefEditForm = class(TosCustomEditForm) @@ -69,6 +69,10 @@ TFilterDefEditForm = class(TosCustomEditForm) cdsEditDetailORDERCOLUMN: TStringField; DBCheckBox1: TDBCheckBox; cdsEditDetailORDERTYPE: TStringField; + Tblimite: TTabSheet; + Label7: TLabel; + EdLimite: TDBEdit; + cdsEditDetailLIMITE: TIntegerField; procedure TestarActionExecute(Sender: TObject); procedure cdsEditNewRecord(DataSet: TDataSet); procedure ApagarFiltroActionExecute(Sender: TObject); From bdf93342ee06d50363c99a93bd30ff619b577460 Mon Sep 17 00:00:00 2001 From: Claudio <------@labplus.com.br> Date: Tue, 31 Jan 2017 09:34:49 -0200 Subject: [PATCH 091/294] Ticket_ID: #54132 - Desativando skip quando acabar o filtro --- Forms/FilterDefEditFormUn.dfm | 2 +- Forms/osCustomMainFrm.pas | 16 +++++++--------- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/Forms/FilterDefEditFormUn.dfm b/Forms/FilterDefEditFormUn.dfm index d76a251..a7bbd6d 100644 --- a/Forms/FilterDefEditFormUn.dfm +++ b/Forms/FilterDefEditFormUn.dfm @@ -118,7 +118,7 @@ inherited FilterDefEditForm: TFilterDefEditForm Top = 272 Width = 490 Height = 195 - ActivePage = Tblimite + ActivePage = TabSheet1 Anchors = [akLeft, akRight, akBottom] TabOrder = 3 object TabSheet1: TTabSheet diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 1dbe404..a492d43 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -211,6 +211,7 @@ TosCustomMainForm = class(TosForm) FSelectedList: TStringListExt; FSelectionField: TField; lastValidSentence: string; + currentCount: Integer; // Field que está sendo usado para ordenação SortField: TField; @@ -553,10 +554,9 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); NewFilter := False; if TComponent(Sender).Name <> 'SkipButton' then begin + currentCount := 0; FSkip := False; NewFilter := True; - //SkipButton.Enabled := True; - //Edtlimit.Enabled := True; end; data := FilterDataset.data; FModifiedList.Clear; @@ -575,15 +575,11 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); ConsultaCombo.ConfigFields(ConsultaCombo.ItemIndex); end; end; - {if FilterDataset.RecordCount <= edtLimit.Value then - begin - SkipButton.Enabled := False; - Edtlimit.Enabled := False; - end;} - - FIDField := FilterDataset.Fields.FindField('ID'); CheckMultiSelection; + + SkipButton.Enabled := ((FilterDataset.RecordCount - currentCount) = edtLimit.Value); + currentCount := FilterDataset.RecordCount; finally Screen.Cursor := crDefault; end; @@ -625,6 +621,8 @@ procedure TosCustomMainForm.FilterDatasetAfterScroll(DataSet: TDataSet); // este método if not IncrementalSearchScrolling then CurrentSearchString := ''; + + SkipButton.Enabled := SkipButton.Enabled and not FilterDataset.Eof; end; function TosCustomMainForm.GetSelectedList: TStringList; From 8e3629e54057597e9e52e5e362667853cf9a8fae Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 17 Feb 2017 14:11:45 -0200 Subject: [PATCH 092/294] ticket_id: #55492 - componente invisivel --- Forms/osCustomMainFrm.dfm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index 39e2fc8..83382ca 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -131,6 +131,7 @@ inherited osCustomMainForm: TosCustomMainForm Width = 30 Height = 13 Caption = 'Limite:' + Visible = False end object tbrFilter: TToolBar Left = 284 @@ -188,6 +189,7 @@ inherited osCustomMainForm: TosCustomMainForm MinValue = 0 TabOrder = 3 Value = 1000 + Visible = False end object tbrSkip: TToolBar Left = 424 @@ -202,6 +204,7 @@ inherited osCustomMainForm: TosCustomMainForm ParentShowHint = False ShowHint = True TabOrder = 4 + Visible = False object SkipButton: TToolButton Left = 0 Top = 0 @@ -2077,7 +2080,7 @@ inherited osCustomMainForm: TosCustomMainForm AutoStop = False PrinterSetup.BinName = 'Default' PrinterSetup.DocumentName = 'Report' - PrinterSetup.PaperName = 'Letter' + PrinterSetup.PaperName = 'Carta' PrinterSetup.PrinterName = 'Default' PrinterSetup.SaveDeviceSettings = False PrinterSetup.mmMarginBottom = 6350 From 885db79544717733f2f74ddc8b03ae672b6b1a96 Mon Sep 17 00:00:00 2001 From: francisco Date: Mon, 27 Feb 2017 14:23:12 -0300 Subject: [PATCH 093/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20merge?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomEditFrm.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 51e180d..6bf4b5e 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -87,7 +87,6 @@ TosCustomEditForm = class(TosForm) procedure ChangeColor(PReadOnly: boolean); procedure ReconcileError(DataSet: TCustomClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction); - procedure ControlButtons; public continue: boolean; constructor Create(AOwner: TComponent); override; From fd191381003d57da18a99041251569d7ed1d7541 Mon Sep 17 00:00:00 2001 From: francisco Date: Tue, 11 Apr 2017 14:31:09 -0300 Subject: [PATCH 094/294] ticket_id: #56728 - removendo packetrecords --- Forms/osCustomMainFrm.dfm | 42 --------------------------------------- Forms/osCustomMainFrm.pas | 28 ++------------------------ 2 files changed, 2 insertions(+), 68 deletions(-) diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index 83382ca..cde7124 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -125,14 +125,6 @@ inherited osCustomMainForm: TosCustomMainForm Flat = True OnClick = EditarTodosButtonClick end - object Label1: TLabel - Left = 324 - Top = 8 - Width = 30 - Height = 13 - Caption = 'Limite:' - Visible = False - end object tbrFilter: TToolBar Left = 284 Top = 0 @@ -180,40 +172,6 @@ inherited osCustomMainForm: TosCustomMainForm TabOrder = 2 OnDblClick = SearchEditDblClick end - object edtLimit: TSpinEdit - Left = 359 - Top = 5 - Width = 55 - Height = 22 - MaxValue = 1000 - MinValue = 0 - TabOrder = 3 - Value = 1000 - Visible = False - end - object tbrSkip: TToolBar - Left = 424 - Top = 0 - Width = 29 - Height = 29 - Align = alNone - AutoSize = True - ButtonHeight = 29 - ButtonWidth = 29 - Caption = 'tbrSkip' - ParentShowHint = False - ShowHint = True - TabOrder = 4 - Visible = False - object SkipButton: TToolButton - Left = 0 - Top = 0 - Hint = 'Carrega os pr'#243'ximos registros' - Action = FilterAction - ImageIndex = 10 - OnClick = SkipButtonClick - end - end end end object StatusBar: TStatusBar [1] diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index a492d43..626733a 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -143,10 +143,6 @@ TosCustomMainForm = class(TosForm) TreeView1: TTreeView; EdtPesquisa: TEdit; Splitter1: TSplitter; - edtLimit: TSpinEdit; - Label1: TLabel; - tbrSkip: TToolBar; - SkipButton: TToolButton; procedure EditActionExecute(Sender: TObject); procedure ViewActionExecute(Sender: TObject); procedure NewActionExecute(Sender: TObject); @@ -201,9 +197,7 @@ TosCustomMainForm = class(TosForm) procedure TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); procedure EdtPesquisaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); - procedure SkipButtonClick(Sender: TObject); private - FSkip: Boolean; FNewFilter: boolean; FUserName: string; FEditForm: TosCustomEditForm; @@ -211,7 +205,6 @@ TosCustomMainForm = class(TosForm) FSelectedList: TStringListExt; FSelectionField: TField; lastValidSentence: string; - currentCount: Integer; // Field que está sendo usado para ordenação SortField: TField; @@ -552,12 +545,6 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); begin inherited; NewFilter := False; - if TComponent(Sender).Name <> 'SkipButton' then - begin - currentCount := 0; - FSkip := False; - NewFilter := True; - end; data := FilterDataset.data; FModifiedList.Clear; if Assigned(FCurrentResource) then @@ -568,7 +555,7 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); ReplaceReportSQLPrint else begin - sent := ConsultaCombo.ExecuteFilter(NewFilter, Edtlimit.Value, FSkip); + sent := ConsultaCombo.ExecuteFilter(NewFilter); if sent = '' then begin FilterDataset.data := data; @@ -578,8 +565,6 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); FIDField := FilterDataset.Fields.FindField('ID'); CheckMultiSelection; - SkipButton.Enabled := ((FilterDataset.RecordCount - currentCount) = edtLimit.Value); - currentCount := FilterDataset.RecordCount; finally Screen.Cursor := crDefault; end; @@ -600,7 +585,7 @@ procedure TosCustomMainForm.ExecLastFilter; Screen.Cursor := crHourglass; try FilterDataset.Close; - ConsultaCombo.ExecuteFilter(FNewFilter, edtLimit.Value, FSkip); + ConsultaCombo.ExecuteFilter(FNewFilter); FNewFilter := false; FIDField := FilterDataset.Fields.FindField('ID'); CheckMultiSelection; @@ -621,8 +606,6 @@ procedure TosCustomMainForm.FilterDatasetAfterScroll(DataSet: TDataSet); // este método if not IncrementalSearchScrolling then CurrentSearchString := ''; - - SkipButton.Enabled := SkipButton.Enabled and not FilterDataset.Eof; end; function TosCustomMainForm.GetSelectedList: TStringList; @@ -745,13 +728,6 @@ procedure TosCustomMainForm.ShowQueryActionExecute(Sender: TObject); ShowQueryAction.Checked := not ShowQueryAction.Checked; end; -procedure TosCustomMainForm.SkipButtonClick(Sender: TObject); -begin - inherited; - FSkip := True; - FilterActionExecute(SkipButton); -end; - procedure TosCustomMainForm.ResourceClick(Sender: TObject); var NewResource: TosAppResource; From ade09e86514a5fcb7e4e5a2f0b2b766d40af4d1c Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 13 Apr 2017 17:54:46 -0300 Subject: [PATCH 095/294] =?UTF-8?q?Ticket=5FID:=20#56928=20-=20implmentar?= =?UTF-8?q?=20o=20log=20de=20qquer=20modifica=C3=A7=C3=A3o=20nos=20valores?= =?UTF-8?q?=20de=20refer=C3=AAncia?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a9b2506..4702508 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1144,6 +1144,7 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; + Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; @@ -1293,27 +1294,33 @@ function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; Alter var nRegCol : Integer; aMsgReg : String; + _Str: TStringList; + _Valor: string; begin Result := EmptyStr; - OriginalCDS.First; - while not OriginalCDS.Eof do - begin - if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then + _Str := TStringList.Create; + try + OriginalCDS.First; + while not OriginalCDS.Eof do begin - if Length(aCampoDescricao) > 0 then + if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then begin - aMsgReg := EmptyStr; - for nRegCol := 0 to Length(aCampoDescricao)-1 do + if Length(aCampoDescricao) > 0 then begin - if aMsgReg <> EmptyStr then - aMsgReg := aMsgReg + ', '; - aMsgReg := aMsgReg + getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); + aMsgReg := EmptyStr; + for nRegCol := 0 to Length(aCampoDescricao)-1 do + begin + _valor := getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); + if _valor <> EmptyStr then + _Str.Add(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).DisplayLabel + ': '+ _valor); + end; end; + Result := Result + #13 + sDescricao + _Str.CommaText; end; - - Result := Result + #13 + sDescricao + aMsgReg; + OriginalCDS.Next; end; - OriginalCDS.Next; + finally + FreeAndNil(_Str); end; end; From e8d3643adca6ebc6124808d114c32806c94ae0ca Mon Sep 17 00:00:00 2001 From: Claudio Date: Tue, 18 Apr 2017 16:04:18 -0300 Subject: [PATCH 096/294] Ticket_ID: #56728 - Corrigindo merge remocao paginacao --- Forms/osCustomMainFrm.pas | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 626733a..bb479f1 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -541,10 +541,8 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); var sent: string; data: oleVariant; - NewFilter : Boolean; begin inherited; - NewFilter := False; data := FilterDataset.data; FModifiedList.Clear; if Assigned(FCurrentResource) then @@ -555,7 +553,7 @@ procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); ReplaceReportSQLPrint else begin - sent := ConsultaCombo.ExecuteFilter(NewFilter); + sent := ConsultaCombo.ExecuteFilter; if sent = '' then begin FilterDataset.data := data; From e44af0336b7fd7cd65789615bc4374bedbe882ce Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 28 Apr 2017 11:05:54 -0300 Subject: [PATCH 097/294] =?UTF-8?q?Ticket=5FID:=20#57631=20-=20bot=C3=A3o?= =?UTF-8?q?=20de=20resultado=20de=20imagem=20na=20tela=20de=20edi=C3=A7?= =?UTF-8?q?=C3=A3o=20de=20resultado?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 94 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 93 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a9b2506..165067e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -6,7 +6,8 @@ interface IBServices, INIFiles, Forms, AbZipper, Windows, SysUtils, StrUtils, Controls, osComboSearch, graphics, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, - osSQLConnection, osSQLQuery, WinSock; + osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, + Vcl.Imaging.GifImg; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -99,6 +100,8 @@ procedure TrimAppMemorySize; function ApenasLetrasNumeros(nStr:String): String; function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; +function Base64FromBinary(const FileName: String): string; +function BinaryFromBase64(const base64: string): TBytesStream; implementation @@ -1369,4 +1372,93 @@ function EspacoDireita(Valor: String; const Tamanho: Integer): String; Result := Valor + Result ; end; +function Base64FromBinary(const FileName: String): string; +var + Input: TBytesStream; + Output: TStringStream; +begin + Input := TBytesStream.Create; + try + Input.LoadFromFile(FileName); + Input.Position := 0; + Output := TStringStream.Create('', TEncoding.ASCII); + try + Soap.EncdDecd.EncodeStream(Input, Output); + Result := Output.DataString; + finally + Output.Free; + end; + finally + Input.Free; + end; +end; + +function BinaryFromBase64(const base64: string): TBytesStream; +var + Input: TStringStream; + Output: TBytesStream; +begin + Input := TStringStream.Create(base64, TEncoding.ASCII); + try + Output := TBytesStream.Create; + try + Soap.EncdDecd.DecodeStream(Input, Output); + Output.Position := 0; + Result := TBytesStream.Create; + try + Result.LoadFromStream(Output); + except + Result.Free; + raise; + end; + finally + Output.Free; + end; + finally + Input.Free; + end; +end; + +procedure DetectImage(const InputFileName: string; BM: TBitmap); +var + FS: TFileStream; + FirstBytes: AnsiString; + Graphic: TGraphic; +begin + Graphic := nil; + FS := TFileStream.Create(InputFileName, fmOpenRead); + try + SetLength(FirstBytes, 8); + FS.Read(FirstBytes[1], 8); + if Copy(FirstBytes, 1, 2) = 'BM' then + begin + Graphic := TBitmap.Create; + end else + if FirstBytes = #137'PNG'#13#10#26#10 then + begin + Graphic := TPngImage.Create; + end else + if Copy(FirstBytes, 1, 3) = 'GIF' then + begin + Graphic := TGIFImage.Create; + end else + if Copy(FirstBytes, 1, 2) = #$FF#$D8 then + begin + Graphic := TJPEGImage.Create; + end; + if Assigned(Graphic) then + begin + try + FS.Seek(0, soFromBeginning); + Graphic.LoadFromStream(FS); + BM.Assign(Graphic); + except + end; + Graphic.Free; + end; + finally + FS.Free; + end; +end; + end. From 536ed036afdbb36bc0b052a0420192c0cbc8d1ff Mon Sep 17 00:00:00 2001 From: francisco Date: Thu, 4 May 2017 15:50:54 -0300 Subject: [PATCH 098/294] ticket_id: #56994 - terminal de consulta --- Forms/osCustomMainFrm.dfm | 9 ++++++--- Forms/osCustomMainFrm.pas | 22 ++++++++++++++++++++-- Lib/UtilsUnit.pas | 18 +++++++++++++++++- 3 files changed, 43 insertions(+), 6 deletions(-) diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index cde7124..233ac8a 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -8,6 +8,7 @@ inherited osCustomMainForm: TosCustomMainForm Menu = MainMenu Visible = True WindowState = wsMaximized + ExplicitTop = -128 ExplicitWidth = 1016 ExplicitHeight = 699 PixelsPerInch = 96 @@ -25,7 +26,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 11 Top = 2 Width = 262 - Height = 29 + Height = 22 AutoSize = True ButtonHeight = 29 ButtonWidth = 29 @@ -243,8 +244,8 @@ inherited osCustomMainForm: TosCustomMainForm TabOrder = 1 end object Grid: TwwDBGrid - Left = 56 - Top = 46 + Left = 83 + Top = 39 Width = 389 Height = 283 IniAttributes.FileName = 'LabMaster.ini.ini' @@ -305,8 +306,10 @@ inherited osCustomMainForm: TosCustomMainForm Width = 163 Height = 21 Align = alBottom + AutoSelect = False TabOrder = 1 OnChange = EdtPesquisaChange + OnEnter = EdtPesquisaEnter OnKeyDown = EdtPesquisaKeyDown end end diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 626733a..0ce280e 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -197,6 +197,7 @@ TosCustomMainForm = class(TosForm) procedure TreeView1CustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); procedure EdtPesquisaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure EdtPesquisaEnter(Sender: TObject); private FNewFilter: boolean; FUserName: string; @@ -279,7 +280,7 @@ TosCustomMainForm = class(TosForm) implementation uses acCustomSQLMainDataUn, FilterDefEditFormUn, RecursoDataUn, - osReportUtils, UtilsUnit, Types; + osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn; {$R *.DFM} @@ -1608,14 +1609,31 @@ procedure TosCustomMainForm.EdtPesquisaChange(Sender: TObject); Self.PesquisaMenu(0,FIndiceMenu); end; +procedure TosCustomMainForm.EdtPesquisaEnter(Sender: TObject); +begin + inherited; + self.OnKeyDown := nil; +end; + procedure TosCustomMainForm.EdtPesquisaKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var vNo : TTreeNode; + TerminalConsultaForm : TTerminalConsultaEditForm; begin inherited; if key = vk_return then begin - if (FUltimoIndiceMenu > 0) and (FIndiceMenu = FUltimoIndiceMenu) then + if isNumeric(EdtPesquisa.Text, False) then + begin + try + TerminalConsultaForm := TTerminalConsultaEditForm.Create(self); + TerminalConsultaForm.pDigitacao := EdtPesquisa.Text; + TerminalConsultaForm.ShowModal; + except + FreeAndNil(TerminalConsultaForm); + end; + end + else if (FUltimoIndiceMenu > 0) and (FIndiceMenu = FUltimoIndiceMenu) then begin FIndiceMenu := 0; Self.PesquisaMenu(0,FIndiceMenu); diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a9b2506..5af5ae2 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -99,6 +99,7 @@ procedure TrimAppMemorySize; function ApenasLetrasNumeros(nStr:String): String; function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; +function KeyToStr(Key:Word): String; implementation @@ -116,7 +117,7 @@ function ApenasLetrasNumeros(nStr:String): String; for I := 1 to Length(nStr) do if nStr[I] in['0'..'9','a'..'z','A'..'Z',Chr(8)] then Result := Result + nStr[I]; -end; +end; function FormataStringList(texto, delimitador: string): string; begin @@ -1369,4 +1370,19 @@ function EspacoDireita(Valor: String; const Tamanho: Integer): String; Result := Valor + Result ; end; +function KeyToStr(Key:Word): String; +var + keyboardState: TKeyboardState; + asciiResult: Integer; +begin + GetKeyboardState(keyboardState); + SetLength(Result, 2); + asciiResult := ToAscii(key, MapVirtualKey(key, 0), keyboardState, @Result[1], 0); + case asciiResult of + 1: SetLength(Result, 1) ; + 2:; + else Result := ''; + end; +end; + end. From 0ef5e24220180323f5c73cd6386a396dca180806 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 12 May 2017 10:58:26 -0300 Subject: [PATCH 099/294] Ticket_id: #57667 - Criada Funcao padrao para chamada do Browser. #57811 #57808 . Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 165067e..090eaff 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -102,6 +102,7 @@ function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; function Base64FromBinary(const FileName: String): string; function BinaryFromBase64(const base64: string): TBytesStream; +procedure dgCreateProcess(const FileName: string); implementation @@ -1461,4 +1462,30 @@ procedure DetectImage(const InputFileName: string; BM: TBitmap); end; end; +procedure dgCreateProcess(const FileName: string); +var ProcInfo: TProcessInformation; + StartInfo: TStartupInfo; +begin + {https://msdn.microsoft.com/en-us/library/ms686331.aspx} + FillMemory(@StartInfo, SizeOf(StartInfo), 0); + StartInfo.cb := SizeOf(StartInfo); + StartInfo.dwFlags := STARTF_RUNFULLSCREEN; + StartInfo.wShowWindow := SW_SHOWMAXIMIZED; + StartInfo.dwXSize := Screen.Width; + StartInfo.dwYSize := Screen.Height; + StartInfo.dwX := 0; + StartInfo.dwY := 0; + + CreateProcess( + nil, + PChar(FileName), + nil, Nil, False, + DEBUG_PROCESS and CREATE_NEW_CONSOLE and CREATE_NEW_PROCESS_GROUP and BELOW_NORMAL_PRIORITY_CLASS, + nil, nil, + StartInfo, + ProcInfo); + CloseHandle(ProcInfo.hProcess); + CloseHandle(ProcInfo.hThread); +end; + end. From 8c3b6cc7af2c7d545b934679b9ff78e92e525c81 Mon Sep 17 00:00:00 2001 From: francisco Date: Fri, 12 May 2017 11:23:47 -0300 Subject: [PATCH 100/294] ticket_id: #57703 - carregar imagem --- Lib/UtilsUnit.pas | 81 ++++++++++++++++++++++++++++------------------- 1 file changed, 48 insertions(+), 33 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 165067e..62b5ff5 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -102,6 +102,7 @@ function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; function Base64FromBinary(const FileName: String): string; function BinaryFromBase64(const base64: string): TBytesStream; +function Base64ToBitmap(base64Field: TBlobField): TBitmap; implementation @@ -1419,46 +1420,60 @@ function BinaryFromBase64(const base64: string): TBytesStream; end; end; -procedure DetectImage(const InputFileName: string; BM: TBitmap); +procedure DetectImage(BS:TBytesStream; BM: TBitmap); var - FS: TFileStream; FirstBytes: AnsiString; Graphic: TGraphic; begin Graphic := nil; - FS := TFileStream.Create(InputFileName, fmOpenRead); - try - SetLength(FirstBytes, 8); - FS.Read(FirstBytes[1], 8); - if Copy(FirstBytes, 1, 2) = 'BM' then - begin - Graphic := TBitmap.Create; - end else - if FirstBytes = #137'PNG'#13#10#26#10 then - begin - Graphic := TPngImage.Create; - end else - if Copy(FirstBytes, 1, 3) = 'GIF' then - begin - Graphic := TGIFImage.Create; - end else - if Copy(FirstBytes, 1, 2) = #$FF#$D8 then - begin - Graphic := TJPEGImage.Create; - end; - if Assigned(Graphic) then - begin - try - FS.Seek(0, soFromBeginning); - Graphic.LoadFromStream(FS); - BM.Assign(Graphic); - except - end; - Graphic.Free; + SetLength(FirstBytes, 8); + BS.Read(FirstBytes[1], 8); + if Copy(FirstBytes, 1, 2) = 'BM' then + begin + Graphic := TBitmap.Create; + end else + if FirstBytes = #137'PNG'#13#10#26#10 then + begin + Graphic := TPngImage.Create; + end else + if Copy(FirstBytes, 1, 3) = 'GIF' then + begin + Graphic := TGIFImage.Create; + end else + if Copy(FirstBytes, 1, 2) = #$FF#$D8 then + begin + Graphic := TJPEGImage.Create; + end; + if Assigned(Graphic) then + begin + try + BS.Seek(0, soFromBeginning); + Graphic.LoadFromStream(BS); + BM.Assign(Graphic); + except end; - finally - FS.Free; + Graphic.Free; end; end; +function Base64ToBitmap(base64Field: TBlobField): TBitmap; +var + ms : TMemoryStream; + base64String : AnsiString; + myFile: TBytesStream; +begin + ms := TMemoryStream.Create; + try + Result := TBitmap.Create; + base64Field.SaveToStream(ms); + ms.Position := 0; + + SetString(base64String, PAnsiChar(ms.Memory), ms.Size); + myFile := BinaryFromBase64(base64String); + DetectImage(myFile, Result); + finally + ms.Free; + end; +end; + end. From 30a0480f0e06138916b5e626f945696b75212a45 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 12 May 2017 16:10:51 -0300 Subject: [PATCH 101/294] Ticket_id: #57667 - Ajuste navegadores, ajuste form Stockfin - Ticket_id: #57807. Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 54 +++++++++++++++++++++++++++++------------------ 1 file changed, 33 insertions(+), 21 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 090eaff..806d579 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -106,7 +106,7 @@ procedure dgCreateProcess(const FileName: string); implementation -uses DateUtils, Variants, StatusUnit; +uses DateUtils, Variants, StatusUnit, UMensagemAguarde; const CSIDL_COMMON_APPDATA = $0023; @@ -1465,27 +1465,39 @@ procedure DetectImage(const InputFileName: string; BM: TBitmap); procedure dgCreateProcess(const FileName: string); var ProcInfo: TProcessInformation; StartInfo: TStartupInfo; + FrmMensagem : TFrmMensagemAguarde; begin - {https://msdn.microsoft.com/en-us/library/ms686331.aspx} - FillMemory(@StartInfo, SizeOf(StartInfo), 0); - StartInfo.cb := SizeOf(StartInfo); - StartInfo.dwFlags := STARTF_RUNFULLSCREEN; - StartInfo.wShowWindow := SW_SHOWMAXIMIZED; - StartInfo.dwXSize := Screen.Width; - StartInfo.dwYSize := Screen.Height; - StartInfo.dwX := 0; - StartInfo.dwY := 0; - - CreateProcess( - nil, - PChar(FileName), - nil, Nil, False, - DEBUG_PROCESS and CREATE_NEW_CONSOLE and CREATE_NEW_PROCESS_GROUP and BELOW_NORMAL_PRIORITY_CLASS, - nil, nil, - StartInfo, - ProcInfo); - CloseHandle(ProcInfo.hProcess); - CloseHandle(ProcInfo.hThread); + FrmMensagem := TFrmMensagemAguarde.Create(Application); + try + FrmMensagem.Show; + FrmMensagem.setMensagem('Aguarde, Carregando... ', True); + FrmMensagem.Update; + + {https://msdn.microsoft.com/en-us/library/ms686331.aspx} + FillMemory(@StartInfo, SizeOf(StartInfo), 0); + StartInfo.cb := SizeOf(StartInfo); + StartInfo.dwFlags := STARTF_RUNFULLSCREEN; + StartInfo.wShowWindow := SW_SHOWMAXIMIZED; + StartInfo.dwXSize := Screen.Width; + StartInfo.dwYSize := Screen.Height; + StartInfo.dwX := 0; + StartInfo.dwY := 0; + + CreateProcess( + nil, + PChar(FileName), + nil, Nil, False, + DEBUG_PROCESS and CREATE_NEW_CONSOLE and CREATE_NEW_PROCESS_GROUP and BELOW_NORMAL_PRIORITY_CLASS, + nil, nil, + StartInfo, + ProcInfo); + CloseHandle(ProcInfo.hProcess); + CloseHandle(ProcInfo.hThread); + finally + SleepEx(10000, False); + FrmMensagem.Close; + FrmMensagem.Release; + end; end; end. From 675164fd3e93a0bc299036add4b6df1cc6a64536 Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 12 May 2017 16:12:13 -0300 Subject: [PATCH 102/294] =?UTF-8?q?Retirada=20de=20memory=20leak=20da=20fu?= =?UTF-8?q?n=C3=A7=C3=A3o=20Base64ToBitmap?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 3d5fc6d..0706fc1 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1472,7 +1472,11 @@ function Base64ToBitmap(base64Field: TBlobField): TBitmap; SetString(base64String, PAnsiChar(ms.Memory), ms.Size); myFile := BinaryFromBase64(base64String); - DetectImage(myFile, Result); + try + DetectImage(myFile, Result); + finally + myFile.Free; + end; finally ms.Free; end; From faf1e27634e70c2ae484066fd71bd8abac181bf4 Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 12 May 2017 16:49:25 -0300 Subject: [PATCH 103/294] Retirada de warnings --- Lib/UtilsUnit.pas | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 299690e..e9808b2 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -448,8 +448,6 @@ function roundToCurr(val: double): double; function isNumeric(valor: string; acceptThousandSeparator: Boolean = False): boolean; -var - decimal: char; begin valor := Trim(valor); if acceptThousandSeparator then @@ -1275,8 +1273,6 @@ function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescr function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; -var - aBookMarkReg : TBookmark; begin Result := EmptyStr; AlteradoCDS.DisableControls; From 8502c6822334da24ad2d70a71844c1bd1b1daffb Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Wed, 17 May 2017 08:32:22 -0300 Subject: [PATCH 104/294] Ticket_id: #57667 - Funcao de teste de conexao - Ticket_id: #57807. Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 40 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 37 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 6111a98..845884a 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -104,10 +104,11 @@ function Base64FromBinary(const FileName: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; procedure dgCreateProcess(const FileName: string); +function TestConection(const url: String): boolean; implementation -uses DateUtils, Variants, StatusUnit, UMensagemAguarde; +uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL; const CSIDL_COMMON_APPDATA = $0023; @@ -1325,7 +1326,7 @@ function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; Alter end; end; -function isRTFValue(vValor: Variant): Boolean; +function isRTFValue(vValor: Variant): Boolean; begin Result := False; if not ValueIsEmptyNull(vValor) then @@ -1460,7 +1461,6 @@ procedure DetectImage(BS:TBytesStream; BM: TBitmap); end; end; - function Base64ToBitmap(base64Field: TBlobField): TBitmap; var ms : TMemoryStream; @@ -1523,4 +1523,38 @@ procedure dgCreateProcess(const FileName: string); end; end; +function TestConection(const url: String): boolean; +var + HTTPClient: TidHTTP; + Stream: TStringStream; + LHandler: TIdSSLIOHandlerSocketOpenSSL; +begin + Result := False; + Stream := TStringStream.Create(''); + + HTTPClient := TidHTTP.Create(nil); + LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTPClient); + HTTPClient.IOHandler := LHandler; + HTTPClient.HandleRedirects := True; + HTTPClient.AllowCookies := True; + HTTPClient.Request.ContentType := 'utf-8'; + HTTPClient.ReadTimeout := 1000; + HTTPClient.ConnectTimeout := 1000; + + try + try + HTTPClient.Get(url, Stream); + Stream.Position := 0; + Result := HTTPClient.ResponseCode.ToBoolean; + except + on E: Exception do + Result := False; + end; + finally + Stream.Free; + LHandler.Free; + HTTPClient.Free; + end; +end; + end. From dc817f9a1f30e3edf3ef10723e6535b3eb1a4fa4 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 18 May 2017 17:46:57 -0300 Subject: [PATCH 105/294] =?UTF-8?q?Ticket=5FID:=20#57730:=20m=C3=A9todo=20?= =?UTF-8?q?para=20ordena=C3=A7=C3=A3o=20de=20campos=20no=20clientdataset?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 67 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 845884a..4e3dd11 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -105,6 +105,9 @@ function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; procedure dgCreateProcess(const FileName: string); function TestConection(const url: String): boolean; +function SortCustomClientDataSet(ClientDataSet: TClientDataSet; + const FieldName: string): Boolean; + implementation @@ -1557,4 +1560,68 @@ function TestConection(const url: String): boolean; end; end; + +function SortCustomClientDataSet(ClientDataSet: TClientDataSet; + const FieldName: string): Boolean; +var + i: Integer; + NewIndexName: string; + IndexOptions: TIndexOptions; + Field: TField; +begin + Result := False; + Field := ClientDataSet.Fields.FindField(FieldName); + + //se for lookup ou calculado + if Field.FieldKind in [fkLookup, fkCalculated] then + exit; + + //Se fieldname inválido, exit. + if Field = nil then Exit; + + //se field type inválido, exit. + if (Field is TObjectField) or (Field is TBlobField) or + (Field is TAggregateField) or (Field is TVariantField) + or (Field is TBinaryField) then Exit; + + //Obter IndexDefs e IndexName usando RTTI + //Garantir que IndexDefs esteja atualizado. + ClientDataSet.IndexDefs.Update; + + //se um índice ascendente já estiver em uso, + //mudar para um índice descendente. + if ClientDataSet.IndexName = FieldName + '__IdxA' + then + begin + NewIndexName := FieldName + '__IdxD'; + IndexOptions := [ixDescending]; + end + else + begin + NewIndexName := FieldName + '__IdxA'; + IndexOptions := []; + end; + + //Procurar um índice existente + for i := 0 to Pred(ClientDataSet.IndexDefs.Count) do + begin + if ClientDataSet.IndexDefs[i].Name = NewIndexName then + begin + Result := True; + Break + end; //if + end; // for + + //Se não enconttrado índice existente, criar um + if not Result then + begin + ClientDataSet.AddIndex(NewIndexName, + FieldName, IndexOptions); + Result := True; + end; // if not + + //Configurar o índice. + ClientDataSet.IndexName := NewIndexName; +end; + end. From cf6847f7dfb7595bb6ec0c7220cea7651db90b49 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Mon, 22 May 2017 15:44:21 -0300 Subject: [PATCH 106/294] =?UTF-8?q?Ticket=5Fid:=20#57671=20-=20Ajustes=20a?= =?UTF-8?q?pos=20o=20teste,=20pasta=20do=20binario=20com=20espa=C3=A7os=20?= =?UTF-8?q?-=20Ticket=5Fid:=20#57820.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 4e3dd11..239de43 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -107,6 +107,7 @@ procedure dgCreateProcess(const FileName: string); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; +function GetShortName(sLongName: string): string; implementation @@ -1624,4 +1625,21 @@ function SortCustomClientDataSet(ClientDataSet: TClientDataSet; ClientDataSet.IndexName := NewIndexName; end; +function GetShortName(sLongName: string): string; +var + sShortName : string; + nShortNameLen : integer; +begin + SetLength(sShortName, MAX_PATH); + nShortNameLen := GetShortPathName( + PChar(sLongName), PChar(sShortName), MAX_PATH - 1 + ); + if (0 = nShortNameLen) then + begin + // handle errors... + end; + SetLength(sShortName, nShortNameLen); + Result := sShortName; +end; + end. From 67916f9eb93f6efa0de99ae1a68a6ab2acd400b4 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 23 May 2017 10:48:45 -0300 Subject: [PATCH 107/294] =?UTF-8?q?Ticket=5FID:=20#57667:=20retirar=20a=20?= =?UTF-8?q?fun=C3=A7=C3=A3o=20getShortName?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 239de43..c0bdd22 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -107,7 +107,6 @@ procedure dgCreateProcess(const FileName: string); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; -function GetShortName(sLongName: string): string; implementation @@ -1625,21 +1624,5 @@ function SortCustomClientDataSet(ClientDataSet: TClientDataSet; ClientDataSet.IndexName := NewIndexName; end; -function GetShortName(sLongName: string): string; -var - sShortName : string; - nShortNameLen : integer; -begin - SetLength(sShortName, MAX_PATH); - nShortNameLen := GetShortPathName( - PChar(sLongName), PChar(sShortName), MAX_PATH - 1 - ); - if (0 = nShortNameLen) then - begin - // handle errors... - end; - SetLength(sShortName, nShortNameLen); - Result := sShortName; -end; end. From 5dc472e723296f9878116090d36f9826fd273127 Mon Sep 17 00:00:00 2001 From: Fabio Contiero Date: Wed, 31 May 2017 11:52:39 -0300 Subject: [PATCH 108/294] Ticket_ID: #57667 - Aumento de timeout visando clientes com internet lenta --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index c0bdd22..6581cdd 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1541,8 +1541,8 @@ function TestConection(const url: String): boolean; HTTPClient.HandleRedirects := True; HTTPClient.AllowCookies := True; HTTPClient.Request.ContentType := 'utf-8'; - HTTPClient.ReadTimeout := 1000; - HTTPClient.ConnectTimeout := 1000; + HTTPClient.ReadTimeout := 30000; + HTTPClient.ConnectTimeout := 30000; try try From 9367a4a8786c940a73519f42bc285ed27cc81770 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Wed, 31 May 2017 17:33:28 -0300 Subject: [PATCH 109/294] =?UTF-8?q?corre=C3=A7=C3=A3o=20merge?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/FilterDefDataUn.dfm | 5 +- Forms/FilterDefEditFormUn.dfm | 165 +------------------------------- Forms/FilterDefEditFormUn.pas | 4 - 3 files changed, 4 insertions(+), 170 deletions(-) diff --git a/Datamodules/FilterDefDataUn.dfm b/Datamodules/FilterDefDataUn.dfm index abb1371..5341e87 100644 --- a/Datamodules/FilterDefDataUn.dfm +++ b/Datamodules/FilterDefDataUn.dfm @@ -34,9 +34,8 @@ object FilterDefData: TFilterDefData CommandText = 'SELECT'#13#10' IDXFilterDefDetail,'#13#10' IDXFilterDef,'#13#10' Number,'#13#10' Des' + 'cription,'#13#10' QueryText,'#13#10' AttributeList,'#13#10' ExpressionList,'#13#10' ' + - 'ConstraintList,'#13#10' OrderList,'#13#10' OrderColumn,'#13#10' OrderType,'#13#10' L' + - 'imite'#13#10'FROM'#13#10' XFilterDefDetail'#13#10'WHERE'#13#10' IDXFilterDef = :IDXFil' + - 'terDef' + 'ConstraintList,'#13#10' OrderList,'#13#10' OrderColumn,'#13#10' OrderType'#13#10'FROM' + + #13#10' XFilterDefDetail'#13#10'WHERE'#13#10' IDXFilterDef = :IDXFilterDef' DataSource = MasterDatasource MaxBlobSize = 32 Params = < diff --git a/Forms/FilterDefEditFormUn.dfm b/Forms/FilterDefEditFormUn.dfm index a7bbd6d..5eb981d 100644 --- a/Forms/FilterDefEditFormUn.dfm +++ b/Forms/FilterDefEditFormUn.dfm @@ -7,6 +7,7 @@ inherited FilterDefEditForm: TFilterDefEditForm Caption = 'Defini'#231#227'o de Filtros' ClientHeight = 501 ClientWidth = 496 + ExplicitTop = -195 ExplicitWidth = 520 ExplicitHeight = 568 PixelsPerInch = 96 @@ -264,26 +265,6 @@ inherited FilterDefEditForm: TFilterDefEditForm ValueUnchecked = 'A' end end - object Tblimite: TTabSheet - Caption = '&Limite' - ImageIndex = 5 - object Label7: TLabel - Left = 11 - Top = 24 - Width = 30 - Height = 13 - Caption = 'Limite:' - end - object EdLimite: TDBEdit - Left = 48 - Top = 20 - Width = 107 - Height = 21 - DataField = 'LIMITE' - DataSource = dsEditDetail - TabOrder = 0 - end - end end object csTeste: TosComboSearch [10] Left = 11 @@ -381,145 +362,6 @@ inherited FilterDefEditForm: TFilterDefEditForm end inherited ImageList: TImageList Left = 276 - Bitmap = { - 494C0101010004001C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 - 0000000000003600000028000000400000001000000001002000000000000010 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000C6C6BD00BDB5AD009C9C94008C84 - 84008C8484008C8484008C8484008C8484008C8484008C8484008C8484008C84 - 84008C84840094948C00B5ADA500000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000063312900633129006331 - 2900633129006331290063312900633129006331290063312900633129006331 - 2900633129007B73730094948C00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00AD847300DEB5A500DEB5 - A500D6ADA500D6AD9C00CEA59C00CE9C9400CE9C8C00C6948C00C6948400C694 - 84008C524200633129008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00B58C7B00FFF7F700FFF7 - F700F7EFEF00F7EFE700EFDED600DEC6B500DEBDAD00D6B5A500D6B5A500DEB5 - A5008C524200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00B58C7B00FFF7F700DEDE - D600DED6CE00DECEC600DECEBD00D6BDAD00CEB5A500CEAD9C00C6A59400DEBD - AD008C524200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00BD948400FFF7F700FFF7 - F700F7F7EF00F7EFEF00F7EFE700EFE7DE00E7D6CE00DEBDAD00D6BDAD00DEBD - B5008C524200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00BD9C8400FFF7F700FFF7 - F700FFF7F700F7F7EF00F7EFEF00F7EFE700EFE7DE00DEC6BD00DEC6B500E7CE - BD008C5A4200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00C69C8C00FFFFF700FFFF - F700FFF7F700FFF7F700F7F7EF00F7EFE700F7EFE700EFD6CE00EFD6C600E7D6 - C600945A4200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00C6A59400C6A59400C69C - 8C00BD948400BD948400BD947B00B58C7B00B5847300AD7B6B009C634A00945A - 4A00945A4A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00CEAD9C00C6A59400C6A5 - 9400BD9C8C00BD9C8400BD948400B58C7B00B58C7B00AD8473009C6352009C63 - 4A00945A4A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00CEAD9C00CEAD9C00C6A5 - 9400C6A58C00BD9C8C00BD9C8400BD947B00B58C7B00B5847300AD7B6B009C63 - 5200945A4A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C6B5A00D6B5A500FFFFFF009C63 - 4A00D6BDAD00FFFFFF00FFFFFF00FFFFFF00FFFFF700FFEFEF00F7EFE700F7E7 - DE009C635200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000946B5A00D6BDAD00FFFFFF009C63 - 4A00D6BDAD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF7F700FFF7EF00FFEF - EF00A56B5A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000946B5A00D6BDB500FFFFFF009C63 - 4A009C634A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFF700FFF7 - F700B58473006331290094948C00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000946B5A00946B5A008C6B - 5A008C635A008C635A008C635A008C6352008C6352008C6352008C6352008C5A - 5200845A5200BDBDB500CEC6BD00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000424D3E000000000000003E000000 - 2800000040000000100000000100010000000000800000000000000000000000 - 000000000000000000000000FFFFFF00FFFF0000000000000001000000000000 - 8001000000000000000100000000000000010000000000000001000000000000 - 0001000000000000000100000000000000010000000000000001000000000000 - 0001000000000000000100000000000000010000000000000001000000000000 - 0001000000000000800100000000000000000000000000000000000000000000 - 000000000000} end inherited MainMenu: TMainMenu Left = 240 @@ -629,9 +471,6 @@ inherited FilterDefEditForm: TFilterDefEditForm FixedChar = True Size = 1 end - object cdsEditDetailLIMITE: TIntegerField - FieldName = 'LIMITE' - end end object dsEditDetail: TDataSource DataSet = cdsEditDetail @@ -678,7 +517,7 @@ inherited FilterDefEditForm: TFilterDefEditForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 297000 PrinterSetup.mmPaperWidth = 210000 - PrinterSetup.PaperSize = 9 + PrinterSetup.PaperSize = 256 ArchiveFileName = '($MyDocuments)\ReportArchive.raf' DeviceType = 'Screen' DefaultFileDeviceType = 'PDF' diff --git a/Forms/FilterDefEditFormUn.pas b/Forms/FilterDefEditFormUn.pas index 4dcc63d..0f70f2a 100644 --- a/Forms/FilterDefEditFormUn.pas +++ b/Forms/FilterDefEditFormUn.pas @@ -69,10 +69,6 @@ TFilterDefEditForm = class(TosCustomEditForm) cdsEditDetailORDERCOLUMN: TStringField; DBCheckBox1: TDBCheckBox; cdsEditDetailORDERTYPE: TStringField; - Tblimite: TTabSheet; - Label7: TLabel; - EdLimite: TDBEdit; - cdsEditDetailLIMITE: TIntegerField; procedure TestarActionExecute(Sender: TObject); procedure cdsEditNewRecord(DataSet: TDataSet); procedure ApagarFiltroActionExecute(Sender: TObject); From 3c58d7bb2276fca57813a5daa717959a794369ac Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 23 Jun 2017 16:15:11 -0300 Subject: [PATCH 110/294] Ticket_id: #59104 - Nova funcao para validacoes de POST e rede Funcao usada no publicador digital para tratativas de rede Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 62 ++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 58 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 37167c5..db41547 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -108,11 +108,11 @@ procedure dgCreateProcess(const FileName: string); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; - +function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil): Boolean; implementation -uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL; +uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData; const CSIDL_COMMON_APPDATA = $0023; @@ -1557,8 +1557,8 @@ function TestConection(const url: String): boolean; HTTPClient.HandleRedirects := True; HTTPClient.AllowCookies := True; HTTPClient.Request.ContentType := 'utf-8'; - HTTPClient.ReadTimeout := 1000; - HTTPClient.ConnectTimeout := 1000; + HTTPClient.ReadTimeout := 30000; + HTTPClient.ConnectTimeout := 30000; try try @@ -1640,5 +1640,59 @@ function SortCustomClientDataSet(ClientDataSet: TClientDataSet; ClientDataSet.IndexName := NewIndexName; end; +function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil) : Boolean; +var + _idHTTP: TIdHTTP; + _resCode: Integer; + + function Fallback: Boolean; + var + _FHttp: TIdHTTP; + begin + _FHttp := TIdHTTP.Create(AOwner); + try + Result := False; + try + if stream is TIdMultiPartFormDataStream then + _FHttp.Post(address, TIdMultiPartFormDataStream(stream)) + else + _FHttp.Post(address, TStringStream(stream)); + _resCode := _FHttp.Response.ResponseCode; + Result := (_resCode > 99) and (_resCode < 400); + except + on E : Exception do + begin + end + end; + finally + FreeAndNil(_FHttp); + end; + end; +begin + Result := False; + _resCode := -1; + _idHTTP := TIdHTTP.Create(AOwner); + try + try + _idHTTP.ReadTimeout := 30000; + _idHTTP.ConnectTimeout := 30000; + _idHTTP.AllowCookies := True; + + _IdHTTP.Head(address); + _resCode := _IdHTTP.Response.ResponseCode; + + Result := (_resCode > 99) and (_resCode < 400); + if not Result then + Result := Fallback; + except + on E : Exception do + begin + Result := Fallback; + end; + end; + finally + FreeAndNil(_idHTTP); + end; +end; end. From 86ff9be72b55ec65a686dc062c040ee664dc5942 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 23 Jun 2017 16:15:11 -0300 Subject: [PATCH 111/294] Ticket_id: #59104 - Nova funcao para validacoes de POST e rede Funcao usada no publicador digital para tratativas de rede Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 58 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 56 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 6581cdd..2f6d8ba 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -107,11 +107,11 @@ procedure dgCreateProcess(const FileName: string); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; - +function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil): Boolean; implementation -uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL; +uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData; const CSIDL_COMMON_APPDATA = $0023; @@ -1624,5 +1624,59 @@ function SortCustomClientDataSet(ClientDataSet: TClientDataSet; ClientDataSet.IndexName := NewIndexName; end; +function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil) : Boolean; +var + _idHTTP: TIdHTTP; + _resCode: Integer; + + function Fallback: Boolean; + var + _FHttp: TIdHTTP; + begin + _FHttp := TIdHTTP.Create(AOwner); + try + Result := False; + try + if stream is TIdMultiPartFormDataStream then + _FHttp.Post(address, TIdMultiPartFormDataStream(stream)) + else + _FHttp.Post(address, TStringStream(stream)); + _resCode := _FHttp.Response.ResponseCode; + Result := (_resCode > 99) and (_resCode < 400); + except + on E : Exception do + begin + end + end; + finally + FreeAndNil(_FHttp); + end; + end; +begin + Result := False; + _resCode := -1; + _idHTTP := TIdHTTP.Create(AOwner); + try + try + _idHTTP.ReadTimeout := 30000; + _idHTTP.ConnectTimeout := 30000; + _idHTTP.AllowCookies := True; + + _IdHTTP.Head(address); + _resCode := _IdHTTP.Response.ResponseCode; + + Result := (_resCode > 99) and (_resCode < 400); + if not Result then + Result := Fallback; + except + on E : Exception do + begin + Result := Fallback; + end; + end; + finally + FreeAndNil(_idHTTP); + end; +end; end. From a18a65cf3c2676fd777af6fb39bd2fd084238a2a Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 29 Jun 2017 14:23:16 -0300 Subject: [PATCH 112/294] =?UTF-8?q?nova=20fun=C3=A7=C3=A3o=20checkChangedF?= =?UTF-8?q?ields?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2f6d8ba..6b506d3 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -79,6 +79,7 @@ function GetIPAddress: string; function ConverteRTF(rtf: string): string; function ConverteTextoToRTF(Texto: string): string; function FieldHasChanged(aField : TField):Boolean; +procedure CheckChangedFields(aDataSet: TClientDataSet; aChangedFields: TStringList); function ValueIsEmptyNull(aValue : Variant):Boolean; function getDescricaoSexo(const vValor : Variant):String; function getDescricaoSimNao(const vValor : Variant):String; @@ -1081,6 +1082,27 @@ function FieldHasChanged(aField : TField):Boolean; end; end; +procedure CheckChangedFields(aDataSet: TClientDataSet; aChangedFields: TStringList); +var + _i: integer; +begin + aChangedFields.Clear; + for _i := 0 to aDataSet.FieldCount - 1 do + begin + if (aDataSet.Fields[_i].FieldKind = fkData) and + (aDataSet.Fields[_i].DataType in [ftString, ftSmallint, ftInteger, ftWord, + ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, + ftWideString, ftLargeint, ftLongWord, ftShortint, + ftByte, ftExtended]) and + (not aDataSet.Fields[_i].IsNull) then + begin + if UtilsUnit.FieldHasChanged(aDataSet.Fields[_i]) then + aChangedFields.Add(aDataSet.Fields[_i].FieldName); + end; + end; +end; + + function ValueIsEmptyNull(aValue : Variant):Boolean; begin Result := VarIsEmpty(aValue) or VarIsNull(aValue); From 17d1e220882bf3e965f1acd99715618cd8868ada Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Thu, 29 Jun 2017 17:10:41 -0300 Subject: [PATCH 113/294] Ticket_id: #59104 - Novas funcoes, portadas as funcoes do Guardiao, e nova funcao para buscar os dados do sistema. Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 437 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 432 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2f6d8ba..ff9f3b8 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -3,11 +3,11 @@ interface uses - IBServices, INIFiles, Forms, AbZipper, Windows, SysUtils, StrUtils, Controls, - osComboSearch, graphics, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, - Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, - osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, - Vcl.Imaging.GifImg; + IBServices, INIFiles, Forms, AbZipper, StrUtils, Controls, + osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, + Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, + osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, + Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -108,6 +108,32 @@ function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil): Boolean; +function GetMacAddress: string; +function GetWindowsDir: string; +function GetPcName: string; +function GetPrinters: string; +function GetWindowsVersion: string; +function GetLanguage: string; +function GetScrollState: string; +function ScreenResolution: string; +function FreeDiskSpace(strDisk: string): string; +function TimeInWindows: string; +function GetPowerStatus: string; +function GetUser: string; +function GetProcessList: string; +function GetSystemDecimal: string; +function GetSystemInfo: string; +function GetWindowPID(sFile: String): Cardinal; +function EnumProcess(hHwnd: HWND; lParam : integer; var FProcessa: Boolean; + var FHWND: HWND; var FPid: DWORD; var iListOfProcess: Integer): boolean; stdcall; +function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: DWORD; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; +function EnumWindowsProc(Wnd: HWND; List: TStringList): BOOL; stdcall; +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: DWORD; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: DWORD; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; +function KillTask(const ExeFileName: string): Integer; implementation @@ -1679,4 +1705,405 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon end; end; +function GetMacAddress: string; +var + Lib: Cardinal; + Func: function(GUID: PGUID): Longint; stdcall; + GUID1, GUID2: TGUID; +begin + Result := EmptyStr; + Lib := LoadLibrary('rpcrt4.dll'); + if Lib <> 0 then + begin + try + @Func := GetProcAddress(Lib, 'UuidCreateSequential'); + if Assigned(Func) then + begin + if (Func(@GUID1) = 0) and + (Func(@GUID2) = 0) and + (GUID1.D4[2] = GUID2.D4[2]) and + (GUID1.D4[3] = GUID2.D4[3]) and + (GUID1.D4[4] = GUID2.D4[4]) and + (GUID1.D4[5] = GUID2.D4[5]) and + (GUID1.D4[6] = GUID2.D4[6]) and + (GUID1.D4[7] = GUID2.D4[7]) then + begin + Result := + IntToHex(GUID1.D4[2], 2) + '-' + + IntToHex(GUID1.D4[3], 2) + '-' + + IntToHex(GUID1.D4[4], 2) + '-' + + IntToHex(GUID1.D4[5], 2) + '-' + + IntToHex(GUID1.D4[6], 2) + '-' + + IntToHex(GUID1.D4[7], 2); + end; + end; + finally + FreeLibrary(Lib) + end; + end; +end; + +function GetWindowsDir: string; +var + PWindowsDir: array [0..255] of Char; +begin + Result := EmptyStr; + GetWindowsDirectory(PWindowsDir,255); + Result := StrPas(PWindowsDir); +end; + +function GetPowerStatus: string; +var + PowerStatus: TSystemPowerStatus; +begin + Result := EmptyStr; + GetSystemPowerStatus(PowerStatus); + if PowerStatus.ACLineStatus=1 then + Result := 'AC power online' + else + Result := 'AC power offline'; +end; + +function GetPrinters: string; +begin + Result := Printer.Printers.Text; +end; + +function GetSystemDecimal: string; +var + MyDecimal: PChar; +begin + Result := EmptyStr; + try + MyDecimal:=StrAlloc(10); + GetLocaleInfo( + LOCALE_SYSTEM_DEFAULT, + LOCALE_SDECIMAL, + MyDecimal, + 10); + Result := 'System decimal is - "'+MyDecimal+'"'; + finally + FreeMem(MyDecimal); + end; +end; + +function GetPcName: string; +var + CompName: array[0..256] of Char; + i: DWord; +begin + Result := EmptyStr; + i:=256; + GetComputerName(CompName, i); + Result := StrPas(CompName); +end; + +function GetProcessList: string; +var + Wnd: hWnd; + Buff: array [0..127] of Char; +begin + Result := EmptyStr; + + Wnd:=GetWindow(Application.Handle, gw_HWndFirst); + while Wnd<>0 do + begin + if (Wnd<>Application.Handle) and + IsWindowVisible(Wnd) and + (GetWindow(Wnd, gw_Owner)=0) and + (GetWindowText(Wnd, Buff, sizeof(buff))<>0) then + begin + GetWindowText(Wnd, Buff, SizeOf(Buff)); + Result := Result + #13#10 + StrPas(Buff); + end; + Wnd:=GetWindow(Wnd, gw_hWndNext); + end; +end; + +function GetUser: string; +var + StrUserName: PChar; + Size: DWord; +begin + Result := EmptyStr; + try + Size:=250; + GetMem(StrUserName, Size); + GetUserName(StrUserName, Size); + Result := StrPas(StrUserName); + finally + FreeMem(StrUserName); + end; +end; + +function GetWindowsVersion: string; +begin + Result := TOSVersion.ToString; +end; + +function TimeInWindows: string; +begin + Result := FormatFloat('0#', GetTickCount div 1000 div 60); +end; + +function FreeDiskSpace(strDisk: string): string; +var + Bytes, Sectors: Cardinal; + freeClusters, totalClusters: Cardinal; +begin + GetDiskFreeSpace(PChar(strDisk), Sectors, Bytes, freeClusters, totalClusters); + FreeDiskSpace := FormatFloat('###,###', (Sectors * Bytes * freeClusters)); +end; + +function ScreenResolution: string; +var + X, Y: longint; +begin + Result := EmptyStr; + + X := GetSystemMetrics(SM_CXSCREEN); + Y := GetSystemMetrics(SM_CYSCREEN); + Result := Format('%dx%d', [X, Y]); +end; + +function GetScrollState: string; +begin + Result := EmptyStr; + + if Odd(GetKeyState(VK_SCROLL)) then + Result := 'On' + else + Result := 'Off'; +end; + +function GetLanguage: string; +var + LanguageID: LangID; + Lang: array[0..100] of char; +begin + Result := EmptyStr; + + LanguageID := GetSystemDefaultLangID; + VerLanguageName(LanguageID, Lang, 100); + Result := string(Lang); +end; + +function GetSystemInfo: string; +begin + Result := 'INFORMAÇÕES DO SISTEMA:'; + Result := Result + #13#10 + '---------------------------------------------------------------------------'; + Result := Result + #13#10 + 'Mac Address: ' + GetMacAddress; + Result := Result + #13#10 + 'Diretório do Windows: ' + GetWindowsDir; + Result := Result + #13#10 + 'Nome do Computador: ' + GetPcName; + Result := Result + #13#10 + 'Impressoras: ' + #13#10 + GetPrinters; + Result := Result + #13#10 + 'Versão do Windows: ' + GetWindowsVersion; + Result := Result + #13#10 + 'Idioma: ' + GetLanguage; + Result := Result + #13#10 + 'Estado do Scroll: ' + GetScrollState; + Result := Result + #13#10 + 'Resolução da Tela: ' + ScreenResolution; + Result := Result + #13#10 + 'Espaço Livre no C: ' + FreeDiskSpace('C'); + Result := Result + #13#10 + 'Horário do Windows: ' + TimeInWindows; + Result := Result + #13#10 + 'Estado de Energia: ' + GetPowerStatus; + Result := Result + #13#10 + 'Usuário: ' + GetUser; + Result := Result + #13#10 + 'Lista de Processos: ' + GetProcessList; + Result := Result + #13#10 + '---------------------------------------------------------------------------'; + //Result := GetSystemDecimal; +end; + +function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: DWORD; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; +begin + if Trim(ATaskName) <> EmptyStr then + begin + FTaskName := ATaskName; + FPid := GetWindowPID(ATaskName); + FProcessa := True; + if not EnumWindows(@EnumProcess, iListOfProcess) then + Exit + else + Application.ProcessMessages; + + Result := FHWND; + end; +end; + +function GetWindowPID(sFile: String): Cardinal; +var + verSystem: TOSVersionInfo; + hdlProcess: THandle; + bPath: Bool; + arrPid: Array [0..1023] of DWORD; + iC: DWord; + k,iCount: Integer; + arrModul: Array [0..299] of Char; + hdlModul: HMODULE; + xHWND : HWND; +begin + Result := 0; + if ExtractFileName(sFile)=sFile then + bPath:=false + else + bPath:=true; + + verSystem.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo); + GetVersionEx(verSystem); + if verSystem.dwPlatformId=VER_PLATFORM_WIN32_NT then + begin + EnumProcesses(@arrPid,SizeOf(arrPid),iC); + iCount := iC div SizeOf(DWORD); + for k := 0 to Pred(iCount) do + begin + hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]); + xHWND := hwnd(hdlProcess); + if (hdlProcess<>0) then + begin + EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC); + GetModuleFilenameEx(hdlProcess,hdlModul,arrModul,SizeOf(arrModul)); + if bPath then + begin + if CompareText(arrModul,sFile) = 0 then + begin + Result := arrPid[k]; + end; + end + else + begin + if CompareText(ExtractFileName(arrModul),sFile) = 0 then + begin + Result := arrPid[k]; + end; + end; + CloseHandle(hdlProcess); + end; + end; + end; +end; + +function EnumProcess(hHwnd: HWND; lParam : integer; var FProcessa: Boolean; + var FHWND: HWND; var FPid: DWORD; var iListOfProcess: Integer): boolean; stdcall; +var + pPid : DWORD; + ClassName : string; + AHWND : HWND; +begin + try + if not FProcessa then + Exit; + + FHWND := 0; + //Se retornar nulo, cancela e sai + if (hHwnd=NULL) then + begin + result := false; + end + else + begin + AHWND := hHWND; + GetWindowThreadProcessId(hHwnd,pPid); + //ClassName do Processo + SetLength(ClassName, 255); + SetLength(ClassName, + GetClassName(hHwnd, + PChar(className), + Length(className))); + if (pPid = FPid) and (UpperCase(className) = UpperCase('TApplication')) then + begin + FHWND := AHWND; + FProcessa := False; + Result := true; + Abort; + end; + Result := true; + end; + except + end; +end; + +function EnumWindowsProc (Wnd: HWND; List: TStringList): BOOL; stdcall; +(*Copy all Task-names into a list*) +var + Caption: Array [0..128] of Char; +begin + Result := True; + SendMessage(Wnd, WM_GETTEXT, Sizeof(Caption), integer(@Caption)); + List.AddObject(Caption, TObject(Wnd)); +end; + +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: DWORD; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + try + FProcessEntry32.dwSize := SizeOf(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + Result := False; + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = + UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = + UpperCase(ExeFileName))) then + begin + Result := True; + ValidaTravamento(UpperCase(ExeFileName), FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + finally + CloseHandle(FSnapshotHandle); + end; +end; + +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: DWORD; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; +var + dwResult: DWORD; + ValorRetorno: Longint; + ObjOleVar : OLEVariant; + AppHandle : THandle; +begin + AppHandle:= UtilsUnit.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + if AppHandle <> 0 then + begin + ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, + SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); + if ValorRetorno > 0 then + //addLogTrava('Respondendo') + Result := True + else + //addLogTrava('*** NÃO RESPONDENDO ***'); + Result := False; + end; +end; + +function KillTask(const ExeFileName: string): Integer; +const + PROCESS_TERMINATE = $0001; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + Result := 0; + FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + FProcessEntry32.dwSize := SizeOf(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = + UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = + UpperCase(ExeFileName))) then + Result := Integer(TerminateProcess( + OpenProcess(PROCESS_TERMINATE, + BOOL(0), + FProcessEntry32.th32ProcessID), + 0)); + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + CloseHandle(FSnapshotHandle); +end; + end. + From a8adf7ab0a7b789ea63d0bc1e2959ef22652570c Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 30 Jun 2017 09:57:33 -0300 Subject: [PATCH 114/294] Ticket_id: #59104 - Ajustes das funcoes do guardiao e remocao de alguns dos warnings Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 293bfc1..9c2af08 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -127,12 +127,12 @@ function GetSystemInfo: string; function GetWindowPID(sFile: String): Cardinal; function EnumProcess(hHwnd: HWND; lParam : integer; var FProcessa: Boolean; var FHWND: HWND; var FPid: DWORD; var iListOfProcess: Integer): boolean; stdcall; -function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: DWORD; +function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; function EnumWindowsProc(Wnd: HWND; List: TStringList): BOOL; stdcall; -function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: DWORD; +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; -function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: DWORD; +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; function KillTask(const ExeFileName: string): Integer; @@ -150,8 +150,8 @@ function ApenasLetrasNumeros(nStr:String): String; begin Result := ''; for I := 1 to Length(nStr) do - if nStr[I] in['0'..'9','a'..'z','A'..'Z',Chr(8)] then - Result := Result + nStr[I]; + if CharInSet(nStr[I], ['0'..'9','a'..'z','A'..'Z',Chr(8)]) then + Result := Result + nStr[I]; end; function FormataStringList(texto, delimitador: string): string; @@ -870,6 +870,7 @@ function RoundToCurrency(const AValue: Currency; const ADigit: TRoundToRange): C function ConverteTecladoNumerico(Key: Word): Word; begin + Result := 190; case Key of VK_NUMPAD0: Result := 48; //96 0 key (numeric keypad) VK_NUMPAD1: Result := 49; //97 1 key (numeric keypad) @@ -1525,7 +1526,7 @@ function Base64ToBitmap(base64Field: TBlobField): TBitmap; ms.Position := 0; SetString(base64String, PAnsiChar(ms.Memory), ms.Size); - myFile := BinaryFromBase64(base64String); + myFile := BinaryFromBase64(string(base64String)); try DetectImage(myFile, Result); finally @@ -1580,7 +1581,6 @@ function TestConection(const url: String): boolean; Stream: TStringStream; LHandler: TIdSSLIOHandlerSocketOpenSSL; begin - Result := False; Stream := TStringStream.Create(''); HTTPClient := TidHTTP.Create(nil); @@ -1701,7 +1701,6 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon end; end; begin - Result := False; _resCode := -1; _idHTTP := TIdHTTP.Create(AOwner); try @@ -1796,6 +1795,7 @@ function GetSystemDecimal: string; MyDecimal: PChar; begin Result := EmptyStr; + MyDecimal := Pwidechar(Widestring(EmptyStr)); try MyDecimal:=StrAlloc(10); GetLocaleInfo( @@ -1848,6 +1848,7 @@ function GetUser: string; Size: DWord; begin Result := EmptyStr; + StrUserName := Pwidechar(Widestring(EmptyStr)); try Size:=250; GetMem(StrUserName, Size); @@ -1931,13 +1932,15 @@ function GetSystemInfo: string; //Result := GetSystemDecimal; end; -function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: DWORD; +function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; begin + Result := FHWND; + if Trim(ATaskName) <> EmptyStr then begin FTaskName := ATaskName; - FPid := GetWindowPID(ATaskName); + FPid := PDWORD_PTR(GetWindowPID(ATaskName)); FProcessa := True; if not EnumWindows(@EnumProcess, iListOfProcess) then Exit @@ -1958,7 +1961,6 @@ function GetWindowPID(sFile: String): Cardinal; k,iCount: Integer; arrModul: Array [0..299] of Char; hdlModul: HMODULE; - xHWND : HWND; begin Result := 0; if ExtractFileName(sFile)=sFile then @@ -1975,7 +1977,6 @@ function GetWindowPID(sFile: String): Cardinal; for k := 0 to Pred(iCount) do begin hdlProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,false,arrPid [k]); - xHWND := hwnd(hdlProcess); if (hdlProcess<>0) then begin EnumProcessModules(hdlProcess,@hdlModul,SizeOf(hdlModul),iC); @@ -2007,6 +2008,8 @@ function EnumProcess(hHwnd: HWND; lParam : integer; var FProcessa: Boolean; ClassName : string; AHWND : HWND; begin + Result := True; + try if not FProcessa then Exit; @@ -2031,10 +2034,10 @@ function EnumProcess(hHwnd: HWND; lParam : integer; var FProcessa: Boolean; begin FHWND := AHWND; FProcessa := False; - Result := true; + Result := True; Abort; end; - Result := true; + Result := True; end; except end; @@ -2050,7 +2053,7 @@ function EnumWindowsProc (Wnd: HWND; List: TStringList): BOOL; stdcall; List.AddObject(Caption, TObject(Wnd)); end; -function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: DWORD; +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; var ContinueLoop: BOOL; @@ -2078,26 +2081,28 @@ function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: DWO end; end; -function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: DWORD; +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; var - dwResult: DWORD; + dwResult: PDWORD_PTR; ValorRetorno: Longint; - ObjOleVar : OLEVariant; AppHandle : THandle; begin + Result := False; + + try AppHandle:= UtilsUnit.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); if AppHandle <> 0 then begin ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); if ValorRetorno > 0 then - //addLogTrava('Respondendo') Result := True else - //addLogTrava('*** NÃO RESPONDENDO ***'); Result := False; end; + except + end; end; function KillTask(const ExeFileName: string): Integer; From c68ca8fedd6c28bdf11cc0922b6fe20a228e61a6 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 30 Jun 2017 10:32:17 -0300 Subject: [PATCH 115/294] Ticket_id: #59104 - Ajuste identacao Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 9c2af08..a13bee3 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -2091,16 +2091,16 @@ function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FP Result := False; try - AppHandle:= UtilsUnit.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); - if AppHandle <> 0 then - begin - ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, - SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); - if ValorRetorno > 0 then - Result := True - else - Result := False; - end; + AppHandle:= UtilsUnit.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + if AppHandle <> 0 then + begin + ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, + SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); + if ValorRetorno > 0 then + Result := True + else + Result := False; + end; except end; end; From 23720c673e6685d52832fdedb3453c65783a4a77 Mon Sep 17 00:00:00 2001 From: paulo Date: Fri, 30 Jun 2017 15:06:50 -0300 Subject: [PATCH 116/294] Ticket_id: #59104 - Ajuste Importacao DB Signed-off-by: Wellington Torrejais da Silva Signed-off-by: paulo --- Lib/UtilsUnit.pas | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a13bee3..2ce7f7d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -104,6 +104,7 @@ function EspacoDireita(Valor: String; const Tamanho: Integer): String; function Base64FromBinary(const FileName: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; +function Base64FromStream(const input: TStream): string; procedure dgCreateProcess(const FileName: string); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; @@ -1451,6 +1452,20 @@ function Base64FromBinary(const FileName: String): string; end; end; +function Base64FromStream(const input: TStream): string; +var + Output: TStringStream; +begin + input.Position := 0; + Output := TStringStream.Create('', TEncoding.ASCII); + try + Soap.EncdDecd.EncodeStream(input, Output); + Result := Output.DataString; + finally + Output.Free; + end; +end; + function BinaryFromBase64(const base64: string): TBytesStream; var Input: TStringStream; From d1bb41a9809926da78b29246c69d1522ce8a31b6 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Mon, 3 Jul 2017 10:03:37 -0300 Subject: [PATCH 117/294] adicionando leitura de memoria no getprocesslist --- Lib/UtilsUnit.pas | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2ce7f7d..d0741c7 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -123,6 +123,7 @@ function TimeInWindows: string; function GetPowerStatus: string; function GetUser: string; function GetProcessList: string; +function getMemoryUsed: Integer; function GetSystemDecimal: string; function GetSystemInfo: string; function GetWindowPID(sFile: String): Cardinal; @@ -1851,12 +1852,23 @@ function GetProcessList: string; (GetWindowText(Wnd, Buff, sizeof(buff))<>0) then begin GetWindowText(Wnd, Buff, SizeOf(Buff)); - Result := Result + #13#10 + StrPas(Buff); + Result := Result + #13#10 + StrPas(Buff) + 'Memória: ' + IntToStr(getMemoryUsed); end; Wnd:=GetWindow(Wnd, gw_hWndNext); end; end; +function getMemoryUsed: Integer; +var + pmc: PROCESS_MEMORY_COUNTERS; +begin + pmc.cb := sizeof(pmc); + + Result := 0; + if GetProcessMemoryInfo(GetCurrentProcess, @pmc, sizeof(pmc)) then + Result := pmc.WorkingSetSize; +end; + function GetUser: string; var StrUserName: PChar; From 7ef0ffc7dae9836c5aa05fc4f5fd1ff2930692f5 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 10 Jul 2017 17:04:45 -0300 Subject: [PATCH 118/294] ticket_id: #58992 - TS 1500 --- Lib/UtilsUnit.pas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index db41547..20f9034 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -88,7 +88,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1133,7 +1133,7 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); var field : TField; i: Integer; @@ -1153,6 +1153,7 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; + Field.Visible := cdsOrigem.Fields[i].Visible; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From ad86ad8ffdc2da533fd7da549ba109f7ce738d18 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Tue, 11 Jul 2017 09:58:34 -0300 Subject: [PATCH 119/294] Ticket_id: #59602 - Ajustes no tratamento de rede do publicador, testando tambem com GET simples Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d0741c7..1f4abbe 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1691,6 +1691,7 @@ function SortCustomClientDataSet(ClientDataSet: TClientDataSet; function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil) : Boolean; var _idHTTP: TIdHTTP; + LHandler: TIdSSLIOHandlerSocketOpenSSL; _resCode: Integer; function Fallback: Boolean; @@ -1699,7 +1700,7 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon begin _FHttp := TIdHTTP.Create(AOwner); try - Result := False; + Result := TestConection(address); try if stream is TIdMultiPartFormDataStream then _FHttp.Post(address, TIdMultiPartFormDataStream(stream)) @@ -1719,11 +1720,14 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon begin _resCode := -1; _idHTTP := TIdHTTP.Create(AOwner); + LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(_idHTTP); try try _idHTTP.ReadTimeout := 30000; _idHTTP.ConnectTimeout := 30000; _idHTTP.AllowCookies := True; + _idHTTP.IOHandler := LHandler; + _idHTTP.HandleRedirects := True; _IdHTTP.Head(address); _resCode := _IdHTTP.Response.ResponseCode; @@ -1739,6 +1743,7 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon end; finally FreeAndNil(_idHTTP); + FreeAndNil(LHandler); end; end; From e09861bd112a667bf7f01dcadd8ef832b818517c Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 28 Jul 2017 09:40:59 -0300 Subject: [PATCH 120/294] =?UTF-8?q?Revert=20"ticket=5Fid:=20#58992=20-=20T?= =?UTF-8?q?S=201500"=20=20deixando=20altera=C3=A7=C3=A3o=20do=20sorter=20e?= =?UTF-8?q?m=20outro=20branch=20para=20liberar=20vers=C3=A3o=203.5?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reverts commit 7ef0ffc7dae9836c5aa05fc4f5fd1ff2930692f5. --- Lib/UtilsUnit.pas | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index c714993..53f558d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -89,7 +89,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1184,7 +1184,7 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); var field : TField; i: Integer; @@ -1204,7 +1204,6 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; - Field.Visible := cdsOrigem.Fields[i].Visible; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 29a8fc7fd55f975e9fc0955bfdc4a9b115acd610 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 3 Aug 2017 11:44:32 -0300 Subject: [PATCH 121/294] =?UTF-8?q?ticket=5Fid:=20#59975:=20refatora=C3=A7?= =?UTF-8?q?=C3=A3o=20dos=20pontos=20que=20chamam=20a=20fun=C3=A7=C3=A3o=20?= =?UTF-8?q?ClonarDatadosClientDataSet?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 2 -- 1 file changed, 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index ee3fabd..f2258d1 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1189,8 +1189,6 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien field : TField; i: Integer; begin - if not Assigned(cdsDestino) then - cdsDestino := TClientDataSet.Create(nil); if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin From da6d540d20ff8699b10740d496e6ac653e3d389c Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 11 Aug 2017 09:32:12 -0300 Subject: [PATCH 122/294] =?UTF-8?q?Revert=20"ticket=5Fid:=20#59975:=20refa?= =?UTF-8?q?tora=C3=A7=C3=A3o=20dos=20pontos=20que=20chamam=20a=20fun=C3=A7?= =?UTF-8?q?=C3=A3o=20ClonarDatadosClientDataSet"?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reverts commit 29a8fc7fd55f975e9fc0955bfdc4a9b115acd610. --- Lib/UtilsUnit.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index ee5e381..53f558d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1189,6 +1189,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC field : TField; i: Integer; begin + if not Assigned(cdsDestino) then + cdsDestino := TClientDataSet.Create(nil); if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin From 838b225833ee6238e6c20c93f7d3e55c0ba0d39d Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 11 Aug 2017 09:36:59 -0300 Subject: [PATCH 123/294] ticket_id: #58992 - TS 1500 --- Lib/UtilsUnit.pas | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 53f558d..8ea1528 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -89,7 +89,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1184,14 +1184,11 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); var field : TField; i: Integer; begin - if not Assigned(cdsDestino) then - cdsDestino := TClientDataSet.Create(nil); - if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin for i := 0 to cdsOrigem.FieldCount-1 do @@ -1204,6 +1201,7 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; + Field.Visible := cdsOrigem.Fields[i].Visible; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 13d7a80458c88a03b5efe8b2dc4c8a46f0c20da2 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Wed, 16 Aug 2017 17:59:50 -0300 Subject: [PATCH 124/294] Ticket_id: #58415 - Nova funcao para converter strings em base64 --- Lib/UtilsUnit.pas | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 53f558d..44c3dda 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -103,6 +103,7 @@ function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; function KeyToStr(Key:Word): String; function Base64FromBinary(const FileName: String): string; +function Base64FromText(const text: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; function Base64FromStream(const input: TStream): string; @@ -1469,6 +1470,11 @@ function Base64FromBinary(const FileName: String): string; end; end; +function Base64FromText(const text: String): string; +begin + Result := EncodeString(text); +end; + function Base64FromStream(const input: TStream): string; var Output: TStringStream; From 56ee61a2d5816814e2ef5bba957c85a939fcab9a Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Sat, 19 Aug 2017 18:45:46 -0300 Subject: [PATCH 125/294] Ticket_id: #57666 - Novas funcoes para uso no recurso de treinamentos Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 52 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 44c3dda..1e829c9 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -139,10 +139,14 @@ function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FP function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; function KillTask(const ExeFileName: string): Integer; +function GetMD5FromString(const text: string): String; +function GetPageAsstring(const url: string): String; +function GetUrlWhitoutParams(const url: String): String; implementation -uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData; +uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, + IdHash, IdHashMessageDigest, IdGlobal, IdURI; const CSIDL_COMMON_APPDATA = $0023; @@ -1646,6 +1650,25 @@ function TestConection(const url: String): boolean; end; end; +function GetPageAsString(const url: String): String; +var + lHTTP: TIdHTTP; + lUri: TIdURI; +begin + Result := EmptyStr; + + if TestConection(url) then + begin + lHTTP := TIdHTTP.Create(Application); + lUri := TIdUri.Create; + try + Result := lHTTP.Get(lUri.URLEncode(url)); + finally + FreeAndNil(lHTTP); + FreeAndNil(lUri); + end; + end; +end; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; @@ -1769,6 +1792,20 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon end; end; +function GetUrlWhitoutParams(const url: String): String; +var + _uri: TIdURI; +begin + Result := EmptyStr; + + _uri := TIdURI.Create(url); + try + Result := _uri.Protocol + '://' + _uri.Host + ':' + _uri.Port + '/'; + finally + FreeAndNil(_uri); + end; +end; + function GetMacAddress: string; var Lib: Cardinal; @@ -2186,5 +2223,18 @@ function KillTask(const ExeFileName: string): Integer; CloseHandle(FSnapshotHandle); end; +function GetMD5FromString(const text: string): String; +var + hashMessageDigest5 : TIdHashMessageDigest5; +begin + Result := EmptyStr; + hashMessageDigest5 := TIdHashMessageDigest5.Create; + try + Result := IdGlobal.IndyLowerCase(hashMessageDigest5.HashStringAsHex(Trim(text))); + finally + FreeAndNil(hashMessageDigest5); + end; +end; + end. From 59416695474d44b8b262ad22e9e619480b293db0 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Sat, 19 Aug 2017 19:02:34 -0300 Subject: [PATCH 126/294] Ticket_id: #57666 - Correcao de Tipo Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1e829c9..822d0a3 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -141,7 +141,7 @@ function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDW function KillTask(const ExeFileName: string): Integer; function GetMD5FromString(const text: string): String; function GetPageAsstring(const url: string): String; -function GetUrlWhitoutParams(const url: String): String; +function GetUrlWithoutParams(const url: String): String; implementation @@ -1792,7 +1792,7 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon end; end; -function GetUrlWhitoutParams(const url: String): String; +function GetUrlWithoutParams(const url: String): String; var _uri: TIdURI; begin From 63c6972dfef28f8276c4138219355563afc18b0f Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Sun, 20 Aug 2017 03:14:14 -0300 Subject: [PATCH 127/294] Ticket_id: #57666 - Novas funcoes para uso no recurso de treinamentos, tratativa para url vazia Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1e829c9..2d0e0e4 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1798,11 +1798,14 @@ function GetUrlWhitoutParams(const url: String): String; begin Result := EmptyStr; - _uri := TIdURI.Create(url); - try - Result := _uri.Protocol + '://' + _uri.Host + ':' + _uri.Port + '/'; - finally - FreeAndNil(_uri); + if url <> EmptyStr then + begin + _uri := TIdURI.Create(url); + try + Result := _uri.Protocol + '://' + _uri.Host + ':' + _uri.Port + '/'; + finally + FreeAndNil(_uri); + end; end; end; From 5315e06e39500d5adf5406b795fbcbfb7227b30b Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Sun, 20 Aug 2017 12:27:18 -0300 Subject: [PATCH 128/294] Ticket_id: #60632 - Novas funcoes usadas na DLL de Crm Email Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index dabeb90..4858148 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -142,6 +142,9 @@ function KillTask(const ExeFileName: string): Integer; function GetMD5FromString(const text: string): String; function GetPageAsstring(const url: string): String; function GetUrlWithoutParams(const url: String): String; +function GetDllName: string; +function GetTempDirectory: string; +function GetLastErrorMessage: string; implementation @@ -2239,5 +2242,30 @@ function GetMD5FromString(const text: string): String; end; end; +function GetDllName: string; +var + szFileName: array[0..MAX_PATH] of Char; +begin + Result := EmptyStr; + FillChar(szFileName, SizeOf(szFileName), #0); + if ( Winapi.Windows.GetModuleFileName(HInstance, szFileName, MAX_PATH) ) > 0 then + Result := string(szFileName); +end; + +function GetTempDirectory: string; +var + tempFolder: array[0..MAX_PATH] of Char; +begin + Result := 'C:\Windows\Temp'; + GetTempPath(MAX_PATH, @tempFolder); + Result := StrPas(tempFolder); +end; + +function GetLastErrorMessage: string; +begin + Result := EmptyStr; + Result := SysErrorMessage(Winapi.Windows.GetLastError); +end; + end. From 4ee86d6102825b5f18ed423b16e84946f5bd348d Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Thu, 31 Aug 2017 17:58:03 -0300 Subject: [PATCH 129/294] Ticket_id: #58411 - Limitacao de execucao da dll por host ou ip - Agendador Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 4858148..64ef923 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -145,11 +145,12 @@ function GetUrlWithoutParams(const url: String): String; function GetDllName: string; function GetTempDirectory: string; function GetLastErrorMessage: string; +function LocalIp: string; implementation uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, - IdHash, IdHashMessageDigest, IdGlobal, IdURI; + IdHash, IdHashMessageDigest, IdGlobal, IdURI, IdIPWatch; const CSIDL_COMMON_APPDATA = $0023; @@ -1023,7 +1024,24 @@ function GetIPAddress: string; tempAddress := longint(pointer(RemoteHost^.h_addr_list^)^); tempAddress := Winsock.ntohl(tempAddress); end; - Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); + Result := Format('%.3d.%.3d.%.3d.%.3d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); +end; + +function LocalIp: string; +var + IPW: TIdIPWatch; +begin + Result := '127.0.0.1'; + + IpW := TIdIPWatch.Create(Application); + try + IpW.Active := True; + if IpW.LocalIP <> EmptyStr then + Result := IpW.LocalIP; + finally + if Assigned(IpW) then + FreeAndNil(IpW); + end; end; class function THSHash.CalculaHash(conteudo: string; pDig : Integer = 2): string; From 248ee99d4434cbb753c7b1e6b61e5133cd49860f Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Fri, 1 Sep 2017 14:12:38 -0300 Subject: [PATCH 130/294] Ticket_id: #58411 - Limitacao de execucao da dll por host ou ip - Agendador Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 64ef923..41671d6 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -146,6 +146,7 @@ function GetDllName: string; function GetTempDirectory: string; function GetLastErrorMessage: string; function LocalIp: string; +function FormatIP(const ip: string): String; implementation @@ -1024,7 +1025,22 @@ function GetIPAddress: string; tempAddress := longint(pointer(RemoteHost^.h_addr_list^)^); tempAddress := Winsock.ntohl(tempAddress); end; - Result := Format('%.3d.%.3d.%.3d.%.3d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); + Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); +end; + +function FormatIP(const ip: string): String; +var + _ip: TStringList; +begin + Result := ip; + _ip := TStringList.Create; + _ip.Delimiter := '.'; + _ip.DelimitedText := ip; + try + Result := Format('%.3d.%.3d.%.3d.%.3d', [StrToIntDef(_ip[0], 1), StrToIntDef(_ip[1], 1), StrToIntDef(_ip[2], 1), StrToIntDef(_ip[3], 1)]); + finally + FreeAndNil(_ip); + end; end; function LocalIp: string; @@ -1037,7 +1053,7 @@ function LocalIp: string; try IpW.Active := True; if IpW.LocalIP <> EmptyStr then - Result := IpW.LocalIP; + Result := FormatIP(IpW.LocalIP); finally if Assigned(IpW) then FreeAndNil(IpW); From 8501537b27280ee2ea61092f13095eb98deaedca Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Tue, 5 Sep 2017 08:59:58 -0300 Subject: [PATCH 131/294] Ticket_id: #60410 - Novas funcoes usadas na emissao parcial Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 72 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 71 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 822d0a3..ff65f2b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -7,7 +7,8 @@ interface osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, - Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics; + Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics, + IdHashSHA; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -142,6 +143,9 @@ function KillTask(const ExeFileName: string): Integer; function GetMD5FromString(const text: string): String; function GetPageAsstring(const url: string): String; function GetUrlWithoutParams(const url: String): String; +function GetSHA1FromString(const text: string): string; +function GetSHA1FromFile(const path: string): string; +function getFileSizeInBytes(const fn: string): integer; implementation @@ -2236,5 +2240,71 @@ function GetMD5FromString(const text: string): String; end; end; +function GetSHA1FromString(const text: string): string; +var + _sha1: TIdHashSHA1; +begin + Result := EmptyStr; + _sha1 := TIdHashSHA1.Create; + try + Result := _sha1.HashStringAsHex(text); + finally + FreeAndNil(_sha1); + end; +end; + +function GetSHA1FromFile(const path: string): string; +var + _sha1: TIdHashSHA1; + _file: TFileStream; + _reader: TBinaryReader; + _size: integer; +begin + Result := EmptyStr; + + _sha1 := TIdHashSHA1.Create; + _size := getFileSizeInBytes(path); + if FileExists(path) then + begin + _file := TFileStream.Create(path,fmOpenRead); + _reader := TBinaryReader.Create(_file); + try + if _size > 0 then + Result := _sha1.HashBytesAsHex(TIdBytes(_reader.ReadBytes(_size))); + finally + FreeAndNil(_sha1); + FreeAndNil(_file); + FreeAndNil(_reader); + end; + end; +end; + +function getFileSizeInBytes(const fn: string): integer; +var + f: File of byte; +begin + Result := -1; + if (FileExists(fn)) then + begin + try + {$I-} + AssignFile(f, fn); + Reset(f); + {$I+} + if (IOResult = 0) then + begin + Result := FileSize(f); + end + else + begin + Result := 0; + end; + finally + {$I-}CloseFile(f);{$I+} + end; + end; +end; + + end. From 2bb2a3e1d74e8511c17eb61d2bef90d87d520afb Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Tue, 5 Sep 2017 16:17:43 -0300 Subject: [PATCH 132/294] Ticket_id: #60410 - Novas funcoes usadas na emissao parcial Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 39 ++++++++++++++------------------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index ff65f2b..f325855 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -145,7 +145,7 @@ function GetPageAsstring(const url: string): String; function GetUrlWithoutParams(const url: String): String; function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; -function getFileSizeInBytes(const fn: string): integer; +function GetFileSize(const filename: widestring): Int64; implementation @@ -2247,7 +2247,8 @@ function GetSHA1FromString(const text: string): string; Result := EmptyStr; _sha1 := TIdHashSHA1.Create; try - Result := _sha1.HashStringAsHex(text); + Result := Trim(_sha1.HashStringAsHex(text)); + Result := LeftStr(Result, 40); finally FreeAndNil(_sha1); end; @@ -2263,14 +2264,15 @@ function GetSHA1FromFile(const path: string): string; Result := EmptyStr; _sha1 := TIdHashSHA1.Create; - _size := getFileSizeInBytes(path); + _size := GetFileSize(path); if FileExists(path) then begin _file := TFileStream.Create(path,fmOpenRead); _reader := TBinaryReader.Create(_file); try if _size > 0 then - Result := _sha1.HashBytesAsHex(TIdBytes(_reader.ReadBytes(_size))); + Result := Trim(_sha1.HashBytesAsHex(TIdBytes(_reader.ReadBytes(_size)))); + Result := LeftStr(Result, 40); finally FreeAndNil(_sha1); FreeAndNil(_file); @@ -2279,32 +2281,19 @@ function GetSHA1FromFile(const path: string): string; end; end; -function getFileSizeInBytes(const fn: string): integer; +function GetFileSize(const filename: widestring): Int64; var - f: File of byte; + sr: TSearchRec; begin Result := -1; - if (FileExists(fn)) then - begin - try - {$I-} - AssignFile(f, fn); - Reset(f); - {$I+} - if (IOResult = 0) then - begin - Result := FileSize(f); - end - else - begin - Result := 0; - end; - finally - {$I-}CloseFile(f);{$I+} - end; + try + if ((FileExists(filename)) and (FindFirst(filename, faAnyFile, sr) = 0)) then + Result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) + + Int64(sr.FindData.nFileSizeLow); + finally + FindClose(sr); end; end; - end. From 55662ae50c21505e2a4038ea3f097204437a5f2e Mon Sep 17 00:00:00 2001 From: "Wellington Torrejais da Silva (Notebook do Desenv)" Date: Thu, 14 Sep 2017 10:53:50 -0300 Subject: [PATCH 133/294] =?UTF-8?q?Ticket=5FId=20#54719:=20Migra=C3=A7?= =?UTF-8?q?=C3=A3o=20para=20Delphi=2010?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/FilterDefDataUn.pas | 2 +- Datamodules/acCustomSQLMainDataUn.dfm | 21 --------------------- Datamodules/acCustomSQLMainDataUn.pas | 14 +------------- Forms/RecursoEditFormUn.pas | 3 ++- Forms/osCustomMainFrm.pas | 2 +- Forms/osFrm.pas | 2 +- Lib/UtilsUnit.pas | 3 ++- 7 files changed, 8 insertions(+), 39 deletions(-) diff --git a/Datamodules/FilterDefDataUn.pas b/Datamodules/FilterDefDataUn.pas index 5625016..f18d584 100644 --- a/Datamodules/FilterDefDataUn.pas +++ b/Datamodules/FilterDefDataUn.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - Provider, Db, DBTables, FMTBcd, SqlExpr, + Provider, Db, FMTBcd, SqlExpr, osSQLDataSetProvider, osCustomDataSetProvider, osUtils, osSQLDataSet; type diff --git a/Datamodules/acCustomSQLMainDataUn.dfm b/Datamodules/acCustomSQLMainDataUn.dfm index 6c43f09..c4eb7d8 100644 --- a/Datamodules/acCustomSQLMainDataUn.dfm +++ b/Datamodules/acCustomSQLMainDataUn.dfm @@ -3,27 +3,6 @@ object acCustomSQLMainData: TacCustomSQLMainData OnCreate = DataModuleCreate Height = 365 Width = 631 - object spGetNewSequence: TStoredProc - StoredProcName = 'dbo.cc_GetNewSequence' - Left = 100 - Top = 200 - ParamData = < - item - DataType = ftInteger - Name = 'Result' - ParamType = ptResult - end - item - DataType = ftString - Name = '@Name' - ParamType = ptInput - end - item - DataType = ftInteger - Name = '@Value' - ParamType = ptOutput - end> - end object prvFilter: TosSQLDataSetProvider DataSet = FilterQuery Options = [poReadOnly, poNoReset, poAllowCommandText] diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 72d3f2d..877e172 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -5,7 +5,7 @@ interface uses SysUtils, Classes, Data.DBXFirebird, FMTBcd, SqlExpr, osSQLDataSet, DB, osSQLConnection, Provider, osCustomDataSetProvider, osSQLDataSetProvider, - DBTables, osClientDataSet, Contnrs, osSQLQuery, Forms, Types, Variants, + osClientDataSet, Contnrs, osSQLQuery, Forms, Types, Variants, Data.DBXInterBase, Data.DBXCommon; const @@ -39,7 +39,6 @@ TRefreshTable = class(TObject) end; TacCustomSQLMainData = class(TDataModule) - spGetNewSequence: TStoredProc; prvFilter: TosSQLDataSetProvider; SQLConnection: TosSQLConnection; FilterQuery: TosSQLDataSet; @@ -77,7 +76,6 @@ TacCustomSQLMainData = class(TDataModule) function GetQuery(meta: boolean = false): TosSQLQuery; procedure FreeQuery(Query: TosSQLQuery); - function GetNextSequence(Nome: string): integer; function GetServerDate: TDatetime; function GetServerDatetime(aConnection: TSQLConnection=nil): TDatetime; function InTransaction: boolean; @@ -453,16 +451,6 @@ function TacCustomSQLMainData.GetNewID(nomeGenerator: String= ''; aConnection: T end; end; -function TacCustomSQLMainData.GetNextSequence(Nome: string): integer; -begin - with spGetNewSequence do - begin - ParamByName('@Name').Value := Nome; - ExecProc; - Result := ParamByName('@Value').Value; - end; -end; - function TacCustomSQLMainData.GetServerDate: TDatetime; begin Result := StrToDatetime(FormatDatetime('dd/mm/yyyy', GetServerDatetime)); diff --git a/Forms/RecursoEditFormUn.pas b/Forms/RecursoEditFormUn.pas index 1da27ac..7c10fb1 100644 --- a/Forms/RecursoEditFormUn.pas +++ b/Forms/RecursoEditFormUn.pas @@ -8,7 +8,8 @@ interface StdCtrls, Mask, DBCtrls, Grids, DBGrids, ComCtrls, wwdbedit, Wwdotdot, Wwdbcomb, Menus, ImgList, osActionList, ToolWin, Buttons, ExtCtrls, osComboSearch, osUtils, - Wwdbigrd, Wwdbgrid, DBTables, Wwdbspin, DBActns, acCustomSQLMainDataUn; + Wwdbigrd, Wwdbgrid, Wwdbspin, DBActns, acCustomSQLMainDataUn, + System.ImageList, System.Actions; type TRecursoEditForm = class(TosCustomEditForm) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index a391462..631134e 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -11,7 +11,7 @@ interface ADODB, Provider, osFrm, osAppResources, ppViewr, ppClass, ppReport, ppComm, ppRelatv, ppDB, ppDBPipe, ppBands, ppCache, ppVar, ppCtrls, ppProd, ppPrnabl, osActionList, osClientDataset, osMD5, - osUtils, OleCtrls, SHDocVw, ppTmplat, osSQLDataSet, dbTables, + osUtils, OleCtrls, SHDocVw, ppTmplat, osSQLDataSet, SqlExpr, Data.DBXFirebird, daIDE, daDBExpress, ppCTDsgn, raIDE, myChkBox, ppModule, daDataModule, FMTBcd, osCustomDataSetProvider, osSQLDataSetProvider, daSQl, daQueryDataView, ppTypes, acCustomReportUn, diff --git a/Forms/osFrm.pas b/Forms/osFrm.pas index 542c919..f2485bd 100644 --- a/Forms/osFrm.pas +++ b/Forms/osFrm.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ActnList, osUtils, ImgList, osActionList, System.Actions; + ActnList, osUtils, ImgList, osActionList, System.Actions, System.ImageList; type TOperacao = (oInserir, oEditar, oExcluir, oVisualizar, oImprimir); diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 41671d6..d44025d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -3,7 +3,8 @@ interface uses - IBServices, INIFiles, Forms, AbZipper, StrUtils, Controls, + {$IFDEF VER250}IBServices,{$ENDIF}{$IFDEF VER320}IBX.IBServices,{$ENDIF} + INIFiles, Forms, AbZipper, StrUtils, Controls, osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, From be55286844d9b44e7c9df3fc5e4f882c4283498a Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 14 Sep 2017 11:02:40 -0300 Subject: [PATCH 134/294] Ticket_Id #54719: Migracao para Delphi 10 --- Forms/RecursoEditFormUn.pas | 2 +- Forms/osFrm.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Forms/RecursoEditFormUn.pas b/Forms/RecursoEditFormUn.pas index 7c10fb1..eef0846 100644 --- a/Forms/RecursoEditFormUn.pas +++ b/Forms/RecursoEditFormUn.pas @@ -9,7 +9,7 @@ interface wwdbedit, Wwdotdot, Wwdbcomb, Menus, ImgList, osActionList, ToolWin, Buttons, ExtCtrls, osComboSearch, osUtils, Wwdbigrd, Wwdbgrid, Wwdbspin, DBActns, acCustomSQLMainDataUn, - System.ImageList, System.Actions; + System.Actions {$IFDEF VER320} , System.ImageList {$ENDIF}; type TRecursoEditForm = class(TosCustomEditForm) diff --git a/Forms/osFrm.pas b/Forms/osFrm.pas index f2485bd..fe28054 100644 --- a/Forms/osFrm.pas +++ b/Forms/osFrm.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ActnList, osUtils, ImgList, osActionList, System.Actions, System.ImageList; + ActnList, osUtils, ImgList, osActionList, System.Actions {$IFDEF VER320} , System.ImageList {$ENDIF}; type TOperacao = (oInserir, oEditar, oExcluir, oVisualizar, oImprimir); From 460e26d37a07043b71c02dfaba2cd873de05e52a Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 14 Sep 2017 17:07:26 -0300 Subject: [PATCH 135/294] =?UTF-8?q?Ticket=5FId=20#54719:=20Migracao=20para?= =?UTF-8?q?=20Delphi=2010=20-=20Incorporada=20fun=C3=A7=C3=A3o=20para=20ch?= =?UTF-8?q?amar=20o=20FolderDialog?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/FolderDialog.pas | 282 +++++++++++++++++++++++++++++++++++++++++++ Lib/UtilsUnit.pas | 20 ++- 2 files changed, 301 insertions(+), 1 deletion(-) create mode 100644 Lib/FolderDialog.pas diff --git a/Lib/FolderDialog.pas b/Lib/FolderDialog.pas new file mode 100644 index 0000000..29860a2 --- /dev/null +++ b/Lib/FolderDialog.pas @@ -0,0 +1,282 @@ +{*********************************************************************} +{ TFolderDialog } +{ for Delphi & C++Builder } +{ } +{ written by } +{ TMS Software } +{ copyright © 2005 - 2011 } +{ Email : info@tmssoftware.com } +{ Web : http://www.tmssoftware.com } +{ } +{ The source code is given as is. The author is not responsible } +{ for any possible damage done due to the use of this code. } +{ The component can be freely used in any application. The source } +{ code remains property of the author and may not be distributed } +{ freely as such. } +{*********************************************************************} + +unit FolderDialog; + +{$DEFINE DELPHI2_LVL} + +interface + +uses + SysUtils, Classes, Windows; + +const + MAJ_VER = 1; // Major version nr. + MIN_VER = 1; // Minor version nr. + REL_VER = 0; // Release nr. + BLD_VER = 2; // Build nr. + + // version history + // v1.0.0.0 : First release + // v1.0.1.0 : improved positioning of directory select dialog on multimonitor machines + // v1.0.1.1 : fix for initializing directory + // v1.0.2.0 : added Caption property + // v1.1.0.0 : Added the fdoEditBox capability + // v1.1.0.1 : Fixed issue with setting parent window handle + // v1.1.0.2 : Fixed issue with default positioning of dialog + +type + + TOptions = (fdoBrowseForComputer, fdoBrowseForPrinter, fdoDontgoBelowDomain, + fdoReturnFSAncestors, fdoReturnOnlyFSDirs, fdoStatusText, + fdoNewDialogStyle, fdoNoNewFolderButton, fdoEditBox); + TFolderOptions = set of TOptions; + TDialogPosition = (fdpDefault, fdpScreenCenter, fdpXY); + + {$IFDEF DELPHIXE2_LVL} + [ComponentPlatformsAttribute(pidWin32 or pidWin64)] + {$ENDIF} + TFolderDialog = class(TComponent) + private + FTitle: string; + FDirectory: string; + FOptions: TFolderOptions; + FImageIndex: Integer; + FDialogX: Integer; + FDialogY: Integer; + FDialogPosition: TDialogPosition; + FCaption: string; + FParent: HWnd; + procedure SetTitle(const Value: string); + procedure SetDirectory(const Value: string); + procedure SetOptions(const Value: TFolderOptions); + procedure SetDialogPosition(const Value: TDialogPosition); + procedure SetDialogX(const Value: Integer); + procedure SetDialogY(const Value: Integer); + function GetVersion: string; + procedure SetVersion(const Value: string); + { Private declarations } + protected + { Protected declarations } + function GetVersionNr: Integer; + function GetParent: HWnd; + public + { Public declarations } + constructor Create(Aowner: TComponent); override; + function Execute: boolean; + published + { Published declarations } + property Caption: string read FCaption write FCaption; + property Title: string read FTitle write SetTitle; + property Directory: string read FDirectory write SetDirectory; + property ImageIndex: Integer read FImageIndex; + property Options: TFolderOptions read FOptions write SetOptions default [fdoNewDialogStyle]; + property DialogPosition: TDialogPosition read FDialogPosition write SetDialogPosition default fdpDefault; + property DialogX: Integer read FDialogX write SetDialogX; + property DialogY: Integer read FDialogY write SetDialogY; + property Version: string read GetVersion write SetVersion; + end; + +implementation + +uses + ShlObj, Forms, ActiveX, Messages, Dialogs; + +const + bif_NoNewFolderButton = $0200; + BIF_NEWDIALOGSTYLE = $0040; + + +function DirectoryExists(const Directory: string): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributes(PChar(Directory)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; + +{ TFolderDialog } + +function FolderDialogCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall; +var + r: TRect; + x,y : Integer; +begin + if (uMsg = BFFM_INITIALIZED) then + begin + with TFolderDialog(lpData) Do + begin + SendMessage (Wnd, BFFM_SETSELECTION, 1, Integer(PChar(Directory))); + x := 0; + y := 0; + case DialogPosition of + fdpDefault: + begin + GetWindowRect(TFolderDialog(lpData).GetParent,r); + x := r.Left + 20; + y := r.Top + 20; + end; + fdpScreenCenter: + begin + GetWindowRect(Wnd,r); + x := Screen.DesktopWidth div 2 - ((r.Right - r.Left) div 2); + y := Screen.DesktopHeight div 2 - ((r.Bottom - r.Top) div 2); + end; + fdpXY: + begin + if DialogX < 0 then + x := 0 + else + x := DialogX; + if DialogY < 0 then + y := 0 + else + y := DialogY; + end; + end; + SetWindowPos(Wnd, HWND_NOTOPMOST, x, y, 0, 0, SWP_NOSIZE or SWP_NOZORDER); + if FCaption <> '' then + SendMessage(Wnd, WM_SETTEXT, 0, Integer(PChar(FCaption))); + end; + end; + Result := 0; +end; + +constructor TFolderDialog.Create(Aowner: TComponent); +begin + inherited Create(AOwner); + if not (csDesigning in ComponentState) then + Directory := GetCurrentDir; + DialogPosition := fdpDefault; + Options := [fdoNewDialogStyle]; + FCaption := ''; +end; + +function TFolderDialog.Execute: boolean; +const + FolderOptions: array [TOptions] of DWORD = ( + bif_BrowseForComputer, bif_BrowseForPrinter, bif_DontgoBelowDomain, + bif_ReturnFSAncestors, bif_ReturnOnlyFSDirs, bif_StatusText, + bif_NewDialogStyle, bif_NoNewFolderButton, bif_EditBox); + +var + bi: TBrowseInfo; + iIdList: PItemIDList; + ResStr: array[0..MAX_PATH] of char; + MAlloc: IMalloc; + O: TOptions; + +begin + FillChar(bi, sizeof(bi), #0); + + if (Owner is TCustomForm) then + bi.hwndOwner := (Owner as TCustomForm).Handle + else + bi.hwndOwner := Application.Handle; + + FParent := bi.hwndOwner; + + bi.lpszTitle := PChar(Title); + If not DirectoryExists(Directory) then + Directory := GetCurrentDir; + + for O := Low(O) to High(O) do + begin + if O in FOptions then + bi.ulFlags := bi.ulFlags or FolderOptions[O]; + end; + + bi.lpfn := FolderDialogCallBack; + bi.lParam := Integer(Self); + iIdList := Nil; + Result := false; + try + iIdList := SHBrowseForFolder(bi); + except + end; + + if iIdList <> Nil then + begin + try + FillChar(ResStr,sizeof(ResStr),#0); + if SHGetPathFromIDList(iIdList, ResStr) then + begin + Directory := StrPas(ResStr); + FImageIndex := bi.iImage; + Result := true; + end; + finally + SHGetMalloc(MAlloc); + Malloc.Free(iIdList); + end; + end; +end; + +function TFolderDialog.GetParent: HWnd; +begin + Result := FParent; +end; + +function TFolderDialog.GetVersion: string; +var + vn: Integer; +begin + vn := GetVersionNr; + Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn))); +end; + +function TFolderDialog.GetVersionNr: Integer; +begin + Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER)); +end; + +procedure TFolderDialog.SetDialogPosition(const Value: TDialogPosition); +begin + FDialogPosition := Value; +end; + +procedure TFolderDialog.SetDialogX(const Value: Integer); +begin + FDialogX := Value; +end; + +procedure TFolderDialog.SetDialogY(const Value: Integer); +begin + FDialogY := Value; +end; + +procedure TFolderDialog.SetDirectory(const Value: string); +begin + FDirectory := Value; +end; + +procedure TFolderDialog.SetOptions(const Value: TFolderOptions); +begin + FOptions := Value; +end; + +procedure TFolderDialog.SetTitle(const Value: string); +begin + FTitle := Value; +end; + +procedure TFolderDialog.SetVersion(const Value: string); +begin + +end; + +end. diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d44025d..4d8dc23 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,7 +8,8 @@ interface osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, - Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics; + Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics, + FolderDialog; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -148,6 +149,7 @@ function GetTempDirectory: string; function GetLastErrorMessage: string; function LocalIp: string; function FormatIP(const ip: string): String; +function ExecuteOpenFolderDialog: string; implementation @@ -2302,5 +2304,21 @@ function GetLastErrorMessage: string; Result := SysErrorMessage(Winapi.Windows.GetLastError); end; +function ExecuteOpenFolderDialog: string; +var + _FD: TFolderDialog; +begin + _FD := TFolderDialog.Create(nil); + try + _FD.DialogX := 0; + _FD.DialogY := 0; + Result := EmptyStr; + if _FD.Execute then + Result := _FD.Directory; + finally + _FD.Free; + end; +end; + end. From dfbc2af9e939add0220b3dbc553a9fe3a762b213 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 14 Sep 2017 17:39:56 -0300 Subject: [PATCH 136/294] =?UTF-8?q?Ticket=5FId=20#54719:=20REtirada=20a=20?= =?UTF-8?q?fun=C3=A7=C3=A3o=20do=20folderDialog?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/FolderDialog.pas | 282 ------------------------------------------- Lib/UtilsUnit.pas | 20 +-- 2 files changed, 1 insertion(+), 301 deletions(-) delete mode 100644 Lib/FolderDialog.pas diff --git a/Lib/FolderDialog.pas b/Lib/FolderDialog.pas deleted file mode 100644 index 29860a2..0000000 --- a/Lib/FolderDialog.pas +++ /dev/null @@ -1,282 +0,0 @@ -{*********************************************************************} -{ TFolderDialog } -{ for Delphi & C++Builder } -{ } -{ written by } -{ TMS Software } -{ copyright © 2005 - 2011 } -{ Email : info@tmssoftware.com } -{ Web : http://www.tmssoftware.com } -{ } -{ The source code is given as is. The author is not responsible } -{ for any possible damage done due to the use of this code. } -{ The component can be freely used in any application. The source } -{ code remains property of the author and may not be distributed } -{ freely as such. } -{*********************************************************************} - -unit FolderDialog; - -{$DEFINE DELPHI2_LVL} - -interface - -uses - SysUtils, Classes, Windows; - -const - MAJ_VER = 1; // Major version nr. - MIN_VER = 1; // Minor version nr. - REL_VER = 0; // Release nr. - BLD_VER = 2; // Build nr. - - // version history - // v1.0.0.0 : First release - // v1.0.1.0 : improved positioning of directory select dialog on multimonitor machines - // v1.0.1.1 : fix for initializing directory - // v1.0.2.0 : added Caption property - // v1.1.0.0 : Added the fdoEditBox capability - // v1.1.0.1 : Fixed issue with setting parent window handle - // v1.1.0.2 : Fixed issue with default positioning of dialog - -type - - TOptions = (fdoBrowseForComputer, fdoBrowseForPrinter, fdoDontgoBelowDomain, - fdoReturnFSAncestors, fdoReturnOnlyFSDirs, fdoStatusText, - fdoNewDialogStyle, fdoNoNewFolderButton, fdoEditBox); - TFolderOptions = set of TOptions; - TDialogPosition = (fdpDefault, fdpScreenCenter, fdpXY); - - {$IFDEF DELPHIXE2_LVL} - [ComponentPlatformsAttribute(pidWin32 or pidWin64)] - {$ENDIF} - TFolderDialog = class(TComponent) - private - FTitle: string; - FDirectory: string; - FOptions: TFolderOptions; - FImageIndex: Integer; - FDialogX: Integer; - FDialogY: Integer; - FDialogPosition: TDialogPosition; - FCaption: string; - FParent: HWnd; - procedure SetTitle(const Value: string); - procedure SetDirectory(const Value: string); - procedure SetOptions(const Value: TFolderOptions); - procedure SetDialogPosition(const Value: TDialogPosition); - procedure SetDialogX(const Value: Integer); - procedure SetDialogY(const Value: Integer); - function GetVersion: string; - procedure SetVersion(const Value: string); - { Private declarations } - protected - { Protected declarations } - function GetVersionNr: Integer; - function GetParent: HWnd; - public - { Public declarations } - constructor Create(Aowner: TComponent); override; - function Execute: boolean; - published - { Published declarations } - property Caption: string read FCaption write FCaption; - property Title: string read FTitle write SetTitle; - property Directory: string read FDirectory write SetDirectory; - property ImageIndex: Integer read FImageIndex; - property Options: TFolderOptions read FOptions write SetOptions default [fdoNewDialogStyle]; - property DialogPosition: TDialogPosition read FDialogPosition write SetDialogPosition default fdpDefault; - property DialogX: Integer read FDialogX write SetDialogX; - property DialogY: Integer read FDialogY write SetDialogY; - property Version: string read GetVersion write SetVersion; - end; - -implementation - -uses - ShlObj, Forms, ActiveX, Messages, Dialogs; - -const - bif_NoNewFolderButton = $0200; - BIF_NEWDIALOGSTYLE = $0040; - - -function DirectoryExists(const Directory: string): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributes(PChar(Directory)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; - -{ TFolderDialog } - -function FolderDialogCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer; stdcall; -var - r: TRect; - x,y : Integer; -begin - if (uMsg = BFFM_INITIALIZED) then - begin - with TFolderDialog(lpData) Do - begin - SendMessage (Wnd, BFFM_SETSELECTION, 1, Integer(PChar(Directory))); - x := 0; - y := 0; - case DialogPosition of - fdpDefault: - begin - GetWindowRect(TFolderDialog(lpData).GetParent,r); - x := r.Left + 20; - y := r.Top + 20; - end; - fdpScreenCenter: - begin - GetWindowRect(Wnd,r); - x := Screen.DesktopWidth div 2 - ((r.Right - r.Left) div 2); - y := Screen.DesktopHeight div 2 - ((r.Bottom - r.Top) div 2); - end; - fdpXY: - begin - if DialogX < 0 then - x := 0 - else - x := DialogX; - if DialogY < 0 then - y := 0 - else - y := DialogY; - end; - end; - SetWindowPos(Wnd, HWND_NOTOPMOST, x, y, 0, 0, SWP_NOSIZE or SWP_NOZORDER); - if FCaption <> '' then - SendMessage(Wnd, WM_SETTEXT, 0, Integer(PChar(FCaption))); - end; - end; - Result := 0; -end; - -constructor TFolderDialog.Create(Aowner: TComponent); -begin - inherited Create(AOwner); - if not (csDesigning in ComponentState) then - Directory := GetCurrentDir; - DialogPosition := fdpDefault; - Options := [fdoNewDialogStyle]; - FCaption := ''; -end; - -function TFolderDialog.Execute: boolean; -const - FolderOptions: array [TOptions] of DWORD = ( - bif_BrowseForComputer, bif_BrowseForPrinter, bif_DontgoBelowDomain, - bif_ReturnFSAncestors, bif_ReturnOnlyFSDirs, bif_StatusText, - bif_NewDialogStyle, bif_NoNewFolderButton, bif_EditBox); - -var - bi: TBrowseInfo; - iIdList: PItemIDList; - ResStr: array[0..MAX_PATH] of char; - MAlloc: IMalloc; - O: TOptions; - -begin - FillChar(bi, sizeof(bi), #0); - - if (Owner is TCustomForm) then - bi.hwndOwner := (Owner as TCustomForm).Handle - else - bi.hwndOwner := Application.Handle; - - FParent := bi.hwndOwner; - - bi.lpszTitle := PChar(Title); - If not DirectoryExists(Directory) then - Directory := GetCurrentDir; - - for O := Low(O) to High(O) do - begin - if O in FOptions then - bi.ulFlags := bi.ulFlags or FolderOptions[O]; - end; - - bi.lpfn := FolderDialogCallBack; - bi.lParam := Integer(Self); - iIdList := Nil; - Result := false; - try - iIdList := SHBrowseForFolder(bi); - except - end; - - if iIdList <> Nil then - begin - try - FillChar(ResStr,sizeof(ResStr),#0); - if SHGetPathFromIDList(iIdList, ResStr) then - begin - Directory := StrPas(ResStr); - FImageIndex := bi.iImage; - Result := true; - end; - finally - SHGetMalloc(MAlloc); - Malloc.Free(iIdList); - end; - end; -end; - -function TFolderDialog.GetParent: HWnd; -begin - Result := FParent; -end; - -function TFolderDialog.GetVersion: string; -var - vn: Integer; -begin - vn := GetVersionNr; - Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn))); -end; - -function TFolderDialog.GetVersionNr: Integer; -begin - Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER)); -end; - -procedure TFolderDialog.SetDialogPosition(const Value: TDialogPosition); -begin - FDialogPosition := Value; -end; - -procedure TFolderDialog.SetDialogX(const Value: Integer); -begin - FDialogX := Value; -end; - -procedure TFolderDialog.SetDialogY(const Value: Integer); -begin - FDialogY := Value; -end; - -procedure TFolderDialog.SetDirectory(const Value: string); -begin - FDirectory := Value; -end; - -procedure TFolderDialog.SetOptions(const Value: TFolderOptions); -begin - FOptions := Value; -end; - -procedure TFolderDialog.SetTitle(const Value: string); -begin - FTitle := Value; -end; - -procedure TFolderDialog.SetVersion(const Value: string); -begin - -end; - -end. diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 4d8dc23..d44025d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,8 +8,7 @@ interface osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, - Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics, - FolderDialog; + Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -149,7 +148,6 @@ function GetTempDirectory: string; function GetLastErrorMessage: string; function LocalIp: string; function FormatIP(const ip: string): String; -function ExecuteOpenFolderDialog: string; implementation @@ -2304,21 +2302,5 @@ function GetLastErrorMessage: string; Result := SysErrorMessage(Winapi.Windows.GetLastError); end; -function ExecuteOpenFolderDialog: string; -var - _FD: TFolderDialog; -begin - _FD := TFolderDialog.Create(nil); - try - _FD.DialogX := 0; - _FD.DialogY := 0; - Result := EmptyStr; - if _FD.Execute then - Result := _FD.Directory; - finally - _FD.Free; - end; -end; - end. From c1b31512f2d9ad22ae8304d3373b6b75f3df73fc Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 21 Sep 2017 17:11:41 -0300 Subject: [PATCH 137/294] =?UTF-8?q?nova=20fun=C3=A7=C3=A3o:=20tryForceDire?= =?UTF-8?q?ctories?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d44025d..05ff9b9 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -148,6 +148,7 @@ function GetTempDirectory: string; function GetLastErrorMessage: string; function LocalIp: string; function FormatIP(const ip: string): String; +function TryForceDirectories(const aDir: string): string; implementation @@ -2302,5 +2303,12 @@ function GetLastErrorMessage: string; Result := SysErrorMessage(Winapi.Windows.GetLastError); end; +function TryForceDirectories(const aDir: string): string; +begin + Result := EmptyStr; + if not ForceDirectories(aDir) then + Result := GetLastErrorMessage; +end; + end. From fd478e1d99f7d2cc4f14a68aadd797bfb6c47580 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 27 Sep 2017 10:26:14 -0300 Subject: [PATCH 138/294] Ticket_id: #61363 - Delphi Tokyo - Retirar o componente Abbrevia --- Lib/UtilsUnit.pas | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 09efad1..ce806aa 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -4,7 +4,7 @@ interface uses {$IFDEF VER250}IBServices,{$ENDIF}{$IFDEF VER320}IBX.IBServices,{$ENDIF} - INIFiles, Forms, AbZipper, StrUtils, Controls, + INIFiles, Forms, System.Zip, System.IOUtils, StrUtils, Controls, osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, @@ -249,10 +249,10 @@ function RemoveAcento(Str:String): String; procedure criarArquivoBackupIB(nomeArq: string); var IBBackup: TIBBackupService; - zipper: TABZipper; + zipper: TZipFile; begin IBBackup := TIBBackupService.Create(nil); - zipper := TAbZipper.Create(nil); + zipper := TZipFile.Create; try DeleteFile('tmp.gbk'); IBBackup.Active := false; @@ -268,9 +268,9 @@ procedure criarArquivoBackupIB(nomeArq: string); while IBBackup.IsServiceRunning do Sleep(1); IBBackup.Active := false; DeleteFile(PCHAR(ExtractFilePath(Application.ExeName) + 'tmp.zip')); - Zipper.FileName := ExtractFilePath(Application.ExeName) + 'tmp.zip'; - Zipper.AddFiles(ExtractFilePath(Application.ExeName) + 'tmp.gbk',0); - Zipper.CloseArchive; + Zipper.Open(ExtractFilePath(Application.ExeName) + 'tmp.zip', zmWrite); + Zipper.Add(ExtractFilePath(Application.ExeName) + 'tmp.gbk'); + Zipper.Close; deleteFile(PCHAR(ExtractFilePath(Application.ExeName) + '..\backups\ultimoBackup.bkp')); CopyFile(PWideChar(ExtractFilePath(Application.ExeName) + 'tmp.zip'), PWideChar(ExtractFilePath(Application.ExeName) + '..\backups\ultimoBackup.bkp'),false); From e441efdbe0640bb8df715e38731a17b61c6f8dc8 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 13 Oct 2017 14:20:42 -0300 Subject: [PATCH 139/294] ticket_id: #61180 - TryForceDirectories --- Lib/UtilsUnit.pas | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index ce806aa..c46c215 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -149,7 +149,8 @@ function GetTempDirectory: string; function GetLastErrorMessage: string; function LocalIp: string; function FormatIP(const ip: string): String; -function TryForceDirectories(const aDir: string): string; +function TryForceDirectories(const aDir: string): String; overload; +function TryForceDirectories(const aDir: string; out aErrorMessage: string): boolean; overload; function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; @@ -2313,6 +2314,12 @@ function TryForceDirectories(const aDir: string): string; Result := GetLastErrorMessage; end; +function TryForceDirectories(const aDir: string; out aErrorMessage: string): boolean; +begin + aErrorMessage := TryForceDirectories(aDir); + Result := aErrorMessage = EmptyStr; +end; + function GetSHA1FromString(const text: string): string; var _sha1: TIdHashSHA1; From 1dd5d389f6a95607047c207a346135961f9cf897 Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 11 Aug 2017 09:36:59 -0300 Subject: [PATCH 140/294] ticket_id: #58992 - TS 1500 --- Lib/UtilsUnit.pas | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index f325855..43b6862 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -90,7 +90,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1193,14 +1193,11 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); var field : TField; i: Integer; begin - if not Assigned(cdsDestino) then - cdsDestino := TClientDataSet.Create(nil); - if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin for i := 0 to cdsOrigem.FieldCount-1 do @@ -1213,6 +1210,7 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; + Field.Visible := cdsOrigem.Fields[i].Visible; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 4d24065f45977165b3d85d3e6532304a3b00f017 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Sun, 20 Aug 2017 12:27:18 -0300 Subject: [PATCH 141/294] Ticket_id: #60632 - Novas funcoes usadas na DLL de Crm Email Signed-off-by: Wellington Torrejais da Silva Conflicts: Lib/UtilsUnit.pas --- Lib/UtilsUnit.pas | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 43b6862..e5cae51 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -146,6 +146,9 @@ function GetUrlWithoutParams(const url: String): String; function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; +function GetDllName: string; +function GetTempDirectory: string; +function GetLastErrorMessage: string; implementation @@ -2293,5 +2296,30 @@ function GetFileSize(const filename: widestring): Int64; end; end; +function GetDllName: string; +var + szFileName: array[0..MAX_PATH] of Char; +begin + Result := EmptyStr; + FillChar(szFileName, SizeOf(szFileName), #0); + if ( Winapi.Windows.GetModuleFileName(HInstance, szFileName, MAX_PATH) ) > 0 then + Result := string(szFileName); +end; + +function GetTempDirectory: string; +var + tempFolder: array[0..MAX_PATH] of Char; +begin + Result := 'C:\Windows\Temp'; + GetTempPath(MAX_PATH, @tempFolder); + Result := StrPas(tempFolder); +end; + +function GetLastErrorMessage: string; +begin + Result := EmptyStr; + Result := SysErrorMessage(Winapi.Windows.GetLastError); +end; + end. From 51f59873d92da7ec75d9520f2ddd1a9896745753 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 30 Oct 2017 08:58:55 -0200 Subject: [PATCH 142/294] ticket_id: #61595 - delta check worklist --- Lib/UtilsUnit.pas | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index c46c215..e3b8588 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -154,6 +154,7 @@ function TryForceDirectories(const aDir: string; out aErrorMessage: string): boo function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; +function GetTelaAprovacao(conn: TosSQLConnection) : string; implementation @@ -2375,5 +2376,24 @@ function GetFileSize(const filename: widestring): Int64; end; end; +function GetTelaAprovacao(conn: TosSQLConnection) : string; +var + qry: TosSQLQuery; +begin + Result := ''; + try + qry := TosSQLQuery.Create(nil); + qry.SQLConnection := conn; + qry.SQL.Text := 'select upper(r.resclassname) as resclassname from recurso r where r.nome = ''Aprovação Resultados'' or (r.filterdefname = ''fltAprovaResultado'')'; + qry.Open; + if not qry.IsEmpty then + Result := qry.FieldByName('resclassname').AsString; + finally + qry.Close; + FreeAndNil(qry); + end; + +end; + end. From 40a071abfb024c6909606d0dcb5ab64592986db2 Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 1 Nov 2017 11:04:29 -0200 Subject: [PATCH 143/294] Revert "ticket_id: #58992 - TS 1500" This reverts commit 1dd5d389f6a95607047c207a346135961f9cf897. --- Lib/UtilsUnit.pas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index e5cae51..8ffbdd1 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -90,7 +90,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1196,11 +1196,14 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); var field : TField; i: Integer; begin + if not Assigned(cdsDestino) then + cdsDestino := TClientDataSet.Create(nil); + if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin for i := 0 to cdsOrigem.FieldCount-1 do @@ -1213,7 +1216,6 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; - Field.Visible := cdsOrigem.Fields[i].Visible; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From d21574043b5f2788fa50a52691bfc4c47d059b00 Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 11 Aug 2017 09:36:59 -0300 Subject: [PATCH 144/294] ticket_id: #58992 - TS 1500 --- Lib/UtilsUnit.pas | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8ffbdd1..e5cae51 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -90,7 +90,7 @@ function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFunca function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; const sCampoChave: String; const sCampoRetorno: String):String; function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; @@ -1196,14 +1196,11 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); var field : TField; i: Integer; begin - if not Assigned(cdsDestino) then - cdsDestino := TClientDataSet.Create(nil); - if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin for i := 0 to cdsOrigem.FieldCount-1 do @@ -1216,6 +1213,7 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; var cdsDestino: TC Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; + Field.Visible := cdsOrigem.Fields[i].Visible; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From b60054e7fb0f511eb87eb280e7fe0b1948474a88 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 29 Nov 2017 13:29:29 -0200 Subject: [PATCH 145/294] Ticket_id: #58411 - Limitacao de execucao da dll por host ou ip - Agendador Signed-off-by: Wellington Torrejais da Silva ticket_id: #61180 - TryForceDirectories --- Lib/UtilsUnit.pas | 96 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 87 insertions(+), 9 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index e5cae51..2317fd8 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -143,17 +143,22 @@ function KillTask(const ExeFileName: string): Integer; function GetMD5FromString(const text: string): String; function GetPageAsstring(const url: string): String; function GetUrlWithoutParams(const url: String): String; -function GetSHA1FromString(const text: string): string; -function GetSHA1FromFile(const path: string): string; -function GetFileSize(const filename: widestring): Int64; function GetDllName: string; function GetTempDirectory: string; function GetLastErrorMessage: string; +function LocalIp: string; +function FormatIP(const ip: string): String; +function TryForceDirectories(const aDir: string): String; overload; +function TryForceDirectories(const aDir: string; out aErrorMessage: string): boolean; overload; +function GetSHA1FromString(const text: string): string; +function GetSHA1FromFile(const path: string): string; +function GetFileSize(const filename: widestring): Int64; + implementation uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, - IdHash, IdHashMessageDigest, IdGlobal, IdURI; + IdHash, IdHashMessageDigest, IdGlobal, IdURI, IdIPWatch; const CSIDL_COMMON_APPDATA = $0023; @@ -1030,6 +1035,38 @@ function GetIPAddress: string; Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); end; +function FormatIP(const ip: string): String; +var + _ip: TStringList; +begin + Result := ip; + _ip := TStringList.Create; + _ip.Delimiter := '.'; + _ip.DelimitedText := ip; + try + Result := Format('%.3d.%.3d.%.3d.%.3d', [StrToIntDef(_ip[0], 1), StrToIntDef(_ip[1], 1), StrToIntDef(_ip[2], 1), StrToIntDef(_ip[3], 1)]); + finally + FreeAndNil(_ip); + end; +end; + +function LocalIp: string; +var + IPW: TIdIPWatch; +begin + Result := '127.0.0.1'; + + IpW := TIdIPWatch.Create(Application); + try + IpW.Active := True; + if IpW.LocalIP <> EmptyStr then + Result := FormatIP(IpW.LocalIP); + finally + if Assigned(IpW) then + FreeAndNil(IpW); + end; +end; + class function THSHash.CalculaHash(conteudo: string; pDig : Integer = 2): string; var sum, i : Integer; @@ -1803,11 +1840,14 @@ function GetUrlWithoutParams(const url: String): String; begin Result := EmptyStr; - _uri := TIdURI.Create(url); - try - Result := _uri.Protocol + '://' + _uri.Host + ':' + _uri.Port + '/'; - finally - FreeAndNil(_uri); + if url <> EmptyStr then + begin + _uri := TIdURI.Create(url); + try + Result := _uri.Protocol + '://' + _uri.Host + ':' + _uri.Port + '/'; + finally + FreeAndNil(_uri); + end; end; end; @@ -2241,6 +2281,44 @@ function GetMD5FromString(const text: string): String; end; end; +function GetDllName: string; +var + szFileName: array[0..MAX_PATH] of Char; +begin + Result := EmptyStr; + FillChar(szFileName, SizeOf(szFileName), #0); + if ( Winapi.Windows.GetModuleFileName(HInstance, szFileName, MAX_PATH) ) > 0 then + Result := string(szFileName); +end; + +function GetTempDirectory: string; +var + tempFolder: array[0..MAX_PATH] of Char; +begin + Result := 'C:\Windows\Temp'; + GetTempPath(MAX_PATH, @tempFolder); + Result := StrPas(tempFolder); +end; + +function GetLastErrorMessage: string; +begin + Result := EmptyStr; + Result := SysErrorMessage(Winapi.Windows.GetLastError); +end; + +function TryForceDirectories(const aDir: string): string; +begin + Result := EmptyStr; + if not ForceDirectories(aDir) then + Result := GetLastErrorMessage; +end; + +function TryForceDirectories(const aDir: string; out aErrorMessage: string): boolean; +begin + aErrorMessage := TryForceDirectories(aDir); + Result := aErrorMessage = EmptyStr; +end; + function GetSHA1FromString(const text: string): string; var _sha1: TIdHashSHA1; From 374eef908dfa90bd344ff8b72a074f09cd496eb8 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 29 Nov 2017 13:31:48 -0200 Subject: [PATCH 146/294] =?UTF-8?q?Ticket=5Fid:=20#62282=20-=20Importar=20?= =?UTF-8?q?as=20fun=C3=A7=C3=B5es=20do=20branch=20develop=20para=20master?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2317fd8..43f9d0f 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -2374,30 +2374,6 @@ function GetFileSize(const filename: widestring): Int64; end; end; -function GetDllName: string; -var - szFileName: array[0..MAX_PATH] of Char; -begin - Result := EmptyStr; - FillChar(szFileName, SizeOf(szFileName), #0); - if ( Winapi.Windows.GetModuleFileName(HInstance, szFileName, MAX_PATH) ) > 0 then - Result := string(szFileName); -end; - -function GetTempDirectory: string; -var - tempFolder: array[0..MAX_PATH] of Char; -begin - Result := 'C:\Windows\Temp'; - GetTempPath(MAX_PATH, @tempFolder); - Result := StrPas(tempFolder); -end; - -function GetLastErrorMessage: string; -begin - Result := EmptyStr; - Result := SysErrorMessage(Winapi.Windows.GetLastError); -end; end. From cd002dee922f80ad9342dac3af8fcd1febfd762c Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 15 Dec 2017 11:34:44 -0200 Subject: [PATCH 147/294] =?UTF-8?q?Novas=20fun=C3=A7=C3=B5es=20de=20execu?= =?UTF-8?q?=C3=A7=C3=A3o=20de=20processos?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 79 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8f448a9..c99b3fa 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -155,6 +155,14 @@ function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; function GetTelaAprovacao(conn: TosSQLConnection) : string; +procedure ExecuteAndWait(const aCommando: string); + +function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +procedure WaitProcess(const aProcessInformation: TProcessInformation); +procedure CloseProcess(const aProcessInformation: TProcessInformation); + + + implementation @@ -2393,5 +2401,76 @@ function GetTelaAprovacao(conn: TosSQLConnection) : string; end; end; +procedure ExecuteAndWait(const aCommando: string); +var + tmpStartupInfo: TStartupInfo; + tmpProcessInformation: TProcessInformation; + tmpProgram: String; +begin + tmpProgram := trim(aCommando); + FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); + with tmpStartupInfo do + begin + cb := SizeOf(TStartupInfo); + wShowWindow := SW_HIDE; + end; + + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, + nil, nil, tmpStartupInfo, tmpProcessInformation) then + begin + // loop every 10 ms + while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do + begin + Application.ProcessMessages; + end; + CloseHandle(tmpProcessInformation.hProcess); + CloseHandle(tmpProcessInformation.hThread); + end + else + begin + RaiseLastOSError; + end; +end; + +function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +var + tmpStartupInfo: TStartupInfo; + tmpProgram: String; +begin + tmpProgram := trim(aCommando); + FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); + with tmpStartupInfo do + begin + cb := SizeOf(TStartupInfo); + wShowWindow := SW_HIDE; + end; + + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, + nil, nil, tmpStartupInfo, aProcessInformation) then + Result := True + else + begin + Result := False; + RaiseLastOSError; + end; +end; + +procedure WaitProcess(const aProcessInformation: TProcessInformation); +begin + // loop every 10 ms + while WaitForSingleObject(aProcessInformation.hProcess, 10) > 0 do + begin + Application.ProcessMessages; + end; + CloseProcess(aProcessInformation); +end; + +procedure CloseProcess(const aProcessInformation: TProcessInformation); +begin + CloseHandle(aProcessInformation.hProcess); + CloseHandle(aProcessInformation.hThread); +end; + + end. From f94c7ea7593331b20dac34f995aaccb2bc3b399f Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 18 Dec 2017 13:27:15 -0200 Subject: [PATCH 148/294] dgCreateProcess com SleepInterval --- Lib/UtilsUnit.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index c99b3fa..dcbb25d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -109,7 +109,7 @@ function Base64FromText(const text: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; function Base64FromStream(const input: TStream): string; -procedure dgCreateProcess(const FileName: string); +procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; @@ -1630,7 +1630,7 @@ function Base64ToBitmap(base64Field: TBlobField): TBitmap; end; end; -procedure dgCreateProcess(const FileName: string); +procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); var ProcInfo: TProcessInformation; StartInfo: TStartupInfo; FrmMensagem : TFrmMensagemAguarde; @@ -1662,7 +1662,7 @@ procedure dgCreateProcess(const FileName: string); CloseHandle(ProcInfo.hProcess); CloseHandle(ProcInfo.hThread); finally - SleepEx(10000, False); + SleepEx(SleepInterval, False); FrmMensagem.Close; FrmMensagem.Release; end; @@ -2445,7 +2445,7 @@ function Execute(const aCommando: string; var aProcessInformation: TProcessInfor wShowWindow := SW_HIDE; end; - if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW or CREATE_DEFAULT_ERROR_MODE, nil, nil, tmpStartupInfo, aProcessInformation) then Result := True else From 683b0bd80d6d92f5f4e8e478dbe93df5f1fb2486 Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 18 Dec 2017 15:12:18 -0200 Subject: [PATCH 149/294] =?UTF-8?q?M=C3=A9todos=20relacionados=20=C3=A0=20?= =?UTF-8?q?Graphical=20User=20Interface=20foram=20transportados=20para=20a?= =?UTF-8?q?=20UtilsUnitGUI.pas?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 804 +++---------------------------------------- Lib/UtilsUnitGUI.pas | 730 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 773 insertions(+), 761 deletions(-) create mode 100644 Lib/UtilsUnitGUI.pas diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index dcbb25d..011983a 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -4,18 +4,14 @@ interface uses {$IFDEF VER250}IBServices,{$ENDIF}{$IFDEF VER320}IBX.IBServices,{$ENDIF} - INIFiles, Forms, System.Zip, System.IOUtils, StrUtils, Controls, - osComboSearch, Classes, DBCtrls, wwdbdatetimepicker, Wwdbcomb, ComCtrls, - Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, + INIFiles, System.Zip, System.IOUtils, StrUtils, + Classes, Math, RegExpr, DB, DBClient, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, - Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics, - IdHashSHA; + Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, + Vcl.Graphics, Winapi.Messages; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); - varArrayOfcomps = array of TComponent; - - TFuncaoParametroGetDesc = function(const vValor : Variant) : string; THSHash = class class function CalculaHash(conteudo: string; pDig : Integer = 2): string; @@ -31,26 +27,12 @@ procedure criarArquivoBackupIB(nomeArq: string); function getSombraValue(Str:String): String; function TiraSimbolos(Str: String): String; function LastDayOfMonth(dia: TDate = 0): TDate; -procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); -procedure setHabilitaComponente(comp: TComponent; enabled: boolean); -procedure habilitaComponentes(comps: varArrayOfcomps); -procedure desHabilitaComponentes(comps: array of TComponent); -procedure setHabilitaDBEdit(edt: TDBEdit; enabled: boolean); -procedure setHabilitaButton(btn: TButton; enabled: boolean); -procedure setHabilitaSpeedButton(btn: TSpeedButton; enabled: boolean); -procedure setHabilitawwComboBox(comboBox: TwwDBComboBox; enabled: boolean); -procedure setHabilitaComboBox(comboBox: TComboBox; enabled: boolean); -procedure setHabilitawwDateTimePicker(dateTimePicker: TwwDBDateTimePicker; enabled: boolean); function roundToCurr(val: double): double; -procedure setHabilitaDBCheckBox(edtd: TDBCheckBox; enabled: boolean); -procedure setHabilitaDBMemo(comp: TDBMemo; enabled: boolean); -procedure setHabilitawwDBGrid(grd: TwwDBGrid; enabled: boolean); procedure ListFileDir(Path: string; FileList: TStrings); function isNumeric(valor: string; acceptThousandSeparator: Boolean = False): boolean; function isIP(valor: string): boolean; function isConvert(Str: string): boolean; function extractPhoneNumber(Str: String; defaultDDD: string = '041'): string; -procedure setHabilitaEdit(edit: TEdit; enabled: boolean); function InvertIntOn(const ANumberL, ANumberH: Integer): Int64; function InvertIntOff(const ANumberL, ANumberH: Integer): Int64; function ConvertIntToBase(ANumber: Int64): string; @@ -65,7 +47,6 @@ function GetHora(tempo: string): Integer; function GetMinuto(tempo: string): Integer; function ConverteData(data: string): TDateTime; function ConverteDataHora(data: string): TDateTime; -procedure ImprimirImpressoraTermica(const comando, impressora: String); function NomeDaTecla(Key: Word): string; function RoundToCurrency(const AValue: Currency; const ADigit: TRoundToRange = -2): Currency; function ConverteTecladoNumerico(Key: Word): Word; @@ -78,28 +59,14 @@ function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; function ConverteStrToDate4(data: string): TDateTime; function GetIPAddress: string; -function ConverteRTF(rtf: string): string; -function ConverteTextoToRTF(Texto: string): string; function FieldHasChanged(aField : TField):Boolean; procedure CheckChangedFields(aDataSet: TClientDataSet; aChangedFields: TStringList); function ValueIsEmptyNull(aValue : Variant):Boolean; function getDescricaoSexo(const vValor : Variant):String; function getDescricaoSimNao(const vValor : Variant):String; function getDescricaoTipoResultado(const vValor : Variant):String; -function CriarMsgLogAlteracaoField(aField : TField):String; overload; -function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; -function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; - const sCampoChave: String; const sCampoRetorno: String):String; -function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); -function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; - const sCampoChave: String; aCampoDescricao: Array of String): String; -function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; - const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; -function isRTFValue(vValor: Variant): Boolean; //{\rtf -function getCampoSemRTF(const vValor : Variant):String; function FormataStringList(texto, delimitador: string): string; -procedure TrimAppMemorySize; function ApenasLetrasNumeros(nStr:String): String; function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; @@ -109,7 +76,6 @@ function Base64FromText(const text: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; function Base64FromStream(const input: TStream): string; -procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); function TestConection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; @@ -117,7 +83,6 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon function GetMacAddress: string; function GetWindowsDir: string; function GetPcName: string; -function GetPrinters: string; function GetWindowsVersion: string; function GetLanguage: string; function GetScrollState: string; @@ -126,28 +91,18 @@ function FreeDiskSpace(strDisk: string): string; function TimeInWindows: string; function GetPowerStatus: string; function GetUser: string; -function GetProcessList: string; function getMemoryUsed: Integer; function GetSystemDecimal: string; -function GetSystemInfo: string; function GetWindowPID(sFile: String): Cardinal; function EnumProcess(hHwnd: HWND; lParam : integer; var FProcessa: Boolean; var FHWND: HWND; var FPid: DWORD; var iListOfProcess: Integer): boolean; stdcall; -function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; function EnumWindowsProc(Wnd: HWND; List: TStringList): BOOL; stdcall; -function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; -function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; function KillTask(const ExeFileName: string): Integer; function GetMD5FromString(const text: string): String; -function GetPageAsstring(const url: string): String; function GetUrlWithoutParams(const url: String): String; function GetDllName: string; function GetTempDirectory: string; function GetLastErrorMessage: string; -function LocalIp: string; function FormatIP(const ip: string): String; function TryForceDirectories(const aDir: string): String; overload; function TryForceDirectories(const aDir: string; out aErrorMessage: string): boolean; overload; @@ -155,24 +110,14 @@ function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; function GetTelaAprovacao(conn: TosSQLConnection) : string; -procedure ExecuteAndWait(const aCommando: string); - -function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; -procedure WaitProcess(const aProcessInformation: TProcessInformation); -procedure CloseProcess(const aProcessInformation: TProcessInformation); - - - +function LocalIp: string; +function GetPageAsstring(const url: string): String; implementation -uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, +uses DateUtils, Variants, StatusUnit, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, IdHash, IdHashMessageDigest, IdGlobal, IdURI, IdIPWatch; -const - CSIDL_COMMON_APPDATA = $0023; - - function ApenasLetrasNumeros(nStr:String): String; Var I: Integer; @@ -218,17 +163,6 @@ procedure ListFileDir(Path: string; FileList: TStrings); end; end; -procedure setHabilitaButton(btn: TButton; enabled: boolean); -begin - btn.Enabled := enabled; -end; - -procedure setHabilitaSpeedButton(btn: TSpeedButton; enabled: boolean); -begin - btn.Enabled := enabled; -end; - - function isDigitOrControl(Key: char): boolean; var um, dois, tres, quatro, cinco: boolean; @@ -265,27 +199,27 @@ procedure criarArquivoBackupIB(nomeArq: string); try DeleteFile('tmp.gbk'); IBBackup.Active := false; - IBBackup.DatabaseName := ExtractFilePath(Application.ExeName) + '..\DB\' + - copy(ExtractFileName(Application.ExeName),1,pos('.',ExtractFileName(Application.ExeName))-1) + '.gdb'; + IBBackup.DatabaseName := ExtractFilePath(ParamStr(0)) + '..\DB\' + + copy(ExtractFileName(ParamStr(0)),1,pos('.',ExtractFileName(ParamStr(0)))-1) + '.gdb'; IBBackup.LoginPrompt := false; IBBackup.Params.Clear; IBBackup.Params.Add('user_name=sysdba'); IBBackup.Params.Add('password=masterkey'); - IBBackup.BackupFile.Add(ExtractFilePath(Application.ExeName) + 'tmp.gbk'); + IBBackup.BackupFile.Add(ExtractFilePath(ParamStr(0)) + 'tmp.gbk'); IBBackup.Active := true; IBBackup.ServiceStart; while IBBackup.IsServiceRunning do Sleep(1); IBBackup.Active := false; - DeleteFile(PCHAR(ExtractFilePath(Application.ExeName) + 'tmp.zip')); - Zipper.Open(ExtractFilePath(Application.ExeName) + 'tmp.zip', zmWrite); - Zipper.Add(ExtractFilePath(Application.ExeName) + 'tmp.gbk'); + DeleteFile(PCHAR(ExtractFilePath(ParamStr(0)) + 'tmp.zip')); + Zipper.Open(ExtractFilePath(ParamStr(0)) + 'tmp.zip', zmWrite); + Zipper.Add(ExtractFilePath(ParamStr(0)) + 'tmp.gbk'); Zipper.Close; - deleteFile(PCHAR(ExtractFilePath(Application.ExeName) + '..\backups\ultimoBackup.bkp')); - CopyFile(PWideChar(ExtractFilePath(Application.ExeName) + 'tmp.zip'), - PWideChar(ExtractFilePath(Application.ExeName) + '..\backups\ultimoBackup.bkp'),false); - RenameFile(ExtractFilePath(Application.ExeName) + 'tmp.zip', nomeArq); - DeleteFile(PCHAR(ExtractFilePath(Application.ExeName) + 'tmp.gbk')); - DeleteFile(PCHAR(ExtractFilePath(Application.ExeName) + 'tmp.zip')) + deleteFile(PCHAR(ExtractFilePath(ParamStr(0)) + '..\backups\ultimoBackup.bkp')); + CopyFile(PWideChar(ExtractFilePath(ParamStr(0)) + 'tmp.zip'), + PWideChar(ExtractFilePath(ParamStr(0)) + '..\backups\ultimoBackup.bkp'),false); + RenameFile(ExtractFilePath(ParamStr(0)) + 'tmp.zip', nomeArq); + DeleteFile(PCHAR(ExtractFilePath(ParamStr(0)) + 'tmp.gbk')); + DeleteFile(PCHAR(ExtractFilePath(ParamStr(0)) + 'tmp.zip')) finally FreeAndNil(zipper); FreeAndNil(IBBackup); @@ -351,156 +285,6 @@ function LastDayOfMonth(dia: TDate = 0): TDate; result := encodedate(y, m, 1) - 1; end; -procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); -begin - if enabled then - begin - cbo.ReadOnly := false; - cbo.color := clWhite; - cbo.showButton := true; - end - else - begin - cbo.ReadOnly := true; - cbo.color := clBtnFace; - cbo.showButton := false; - end; - cbo.invalidate; -end; - -procedure setHabilitaDBEdit(edt: TDBEdit; enabled: boolean); -begin - if enabled then - begin - edt.ReadOnly := false; - edt.color := clWhite; - end - else - begin - edt.ReadOnly := true; - edt.color := clBtnFace; - end; -end; - -procedure setHabilitawwComboBox(comboBox: TwwDBComboBox; enabled: boolean); -begin - if enabled then - begin - comboBox.ReadOnly := false; - comboBox.Color := clWhite; - end - else - begin - comboBox.ReadOnly := true; - comboBox.Color := clBtnFace; - end; -end; - -procedure setHabilitaComboBox(comboBox: TComboBox; enabled: boolean); -begin - if enabled then - begin - comboBox.Enabled := True; - comboBox.Color := clWhite; - end - else - begin - comboBox.Enabled := False; - comboBox.Color := clBtnFace; - end; -end; - -procedure setHabilitawwDateTimePicker(dateTimePicker: TwwDBDateTimePicker; enabled: boolean); -begin - if enabled then - begin - dateTimePicker.ReadOnly := false; - dateTimePicker.Color := clWhite; - end - else - begin - dateTimePicker.ReadOnly := true; - dateTimePicker.Color := clBtnFace; - end; -end; - -procedure setHabilitaDBCheckBox(edtd: TDBCheckBox; enabled: boolean); -begin - if enabled then - begin - edtd.ReadOnly := false; - end - else - begin - edtd.ReadOnly := true; - end; -end; - -procedure setHabilitawwDBGrid(grd: TwwDBGrid; enabled: boolean); -begin - if enabled then - begin - grd.ReadOnly := false; - end - else - begin - grd.ReadOnly := true; - end; -end; - - -procedure setHabilitaDBMemo(comp: TDBMemo; enabled: boolean); -begin - if enabled then - begin - comp.enabled := true; - comp.Color := clWhite; - end - else - begin - comp.enabled := false; - comp.Color := clBtnFace; - end; -end; - -procedure setHabilitaComponente(comp: TComponent; enabled: boolean); -begin - if comp is TosComboSearch then - setHabilitaComboSearch((comp as TosComboSearch), enabled); - if comp is TDBEdit then - setHabilitaDBEdit((comp as TDBEdit), enabled); - if comp is TwwDBComboBox then - setHabilitawwComboBox((comp as TwwDBComboBox), enabled); - if comp is TwwDBDateTimePicker then - setHabilitawwDateTimePicker((comp as TwwDBDateTimePicker), enabled); - if comp is TDBCheckBox then - setHabilitadbCheckBox((comp as TDBCheckBox), enabled); - if comp is TDBMemo then - setHabilitaDBMemo((comp as TDBMemo), enabled); - if comp is TwwDBGrid then - setHabilitawwDBGrid((comp as twwDBGrid), enabled); - if comp is TButton then - setHabilitaButton((comp as TButton), enabled); - if comp is TSpeedButton then - setHabilitaSpeedButton((comp as TSpeedButton), enabled); -end; - -procedure habilitaComponentes(comps: varArrayOfcomps); -var - i: integer; -begin - for i := low(comps) to high(comps) do - setHabilitaComponente(comps[i], true); -end; - -procedure desHabilitaComponentes(comps: array of TComponent); -var - i: integer; -begin - for i := low(comps) to high(comps) do - setHabilitaComponente(comps[i], false); -end; - function roundToCurr(val: double): double; begin result := roundTo(val, -2); @@ -589,20 +373,6 @@ function extractPhoneNumber(Str: String; defaultDDD: string = '041'): string; result := '00000000000'; end; -procedure setHabilitaEdit(edit: TEdit; enabled: boolean); -begin - if enabled then - begin - edit.ReadOnly := false; - edit.Color := clWhite; - end - else - begin - edit.ReadOnly := true; - edit.Color := clBtnFace; - end; -end; - function InvertIntOn(const ANumberL, ANumberH: Integer): Int64; asm XOR EAX,$FFFFFFFF @@ -780,34 +550,6 @@ function GetMinuto(tempo: string): Integer; Result := StrToIntDef(Trim(Copy(tempo,tam-1,2)),0); end; -procedure ImprimirImpressoraTermica(const comando, impressora: String); -var - FBat, FComando: TextFile; - diretorio: string; -begin - diretorio:= GetSpecialFolderLocation(Application.Handle, CSIDL_COMMON_APPDATA) + '\'; - - DeleteFile(diretorio + 'COMANDO.TXT'); - DeleteFile(diretorio + 'PRINTLBL.BAT'); - - AssignFile(FComando, diretorio + 'COMANDO.TXT'); - try - Rewrite(FComando); - Writeln(FComando, comando); - finally - CloseFile(FComando); - end; - - AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); - try - Rewrite(FBat); - Writeln(FBat, 'TYPE "' + diretorio + 'COMANDO.TXT" > "'+impressora+'"'); - finally - CloseFile(FBat); - end; - - ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); -end; function NomeDaTecla(Key: Word): string; var @@ -1059,23 +801,6 @@ function FormatIP(const ip: string): String; end; end; -function LocalIp: string; -var - IPW: TIdIPWatch; -begin - Result := '127.0.0.1'; - - IpW := TIdIPWatch.Create(Application); - try - IpW.Active := True; - if IpW.LocalIP <> EmptyStr then - Result := FormatIP(IpW.LocalIP); - finally - if Assigned(IpW) then - FreeAndNil(IpW); - end; -end; - class function THSHash.CalculaHash(conteudo: string; pDig : Integer = 2): string; var sum, i : Integer; @@ -1111,52 +836,6 @@ class function THSHash.GeraHashPCMed(linha: string): string; Result := hexa; end; -function ConverteRTF(rtf: string): string; -var - form: TForm; - richEdit: TRichEdit; - ss: TStringStream; -begin - try - ss := TStringStream.Create(rtf); - form := TForm.Create(nil); - richEdit := TRichEdit.Create(form); - richEdit.Parent := form; - richEdit.Lines.LoadFromStream(ss); - richEdit.PlainText := True; - Result := richEdit.Text; - finally - FreeAndNil(ss); - FreeAndNil(richEdit); - FreeAndNil(form); - end; -end; - -function ConverteTextoToRTF(Texto: string): string; -var - form: TForm; - richEdit: TRichEdit; - ss: TStringStream; -begin - if not isRTFValue(Texto) then - begin - try - ss := TStringStream.Create(Texto); - form := TForm.Create(nil); - richEdit := TRichEdit.Create(form); - richEdit.Parent := form; - richEdit.Text:= Texto; - richEdit.PlainText := False; - richEdit.Lines.SaveToStream(ss); - Result := ss.DataString; - finally - FreeAndNil(ss); - FreeAndNil(richEdit); - FreeAndNil(form); - end; - end; -end; - function FieldHasChanged(aField : TField):Boolean; begin case AField.DataType of @@ -1284,194 +963,6 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien end; end; -function CriarMsgLogAlteracaoField(aField : TField):String; overload; -begin - Result := EmptyStr; - if FieldHasChanged(aField) then - Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), - getCampoSemRTF(aField.NewValue)]); - -end; - -function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; -begin - Result := EmptyStr; - if FieldHasChanged(aField) then - Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, aFuncaoGetDescricao(aField.OldValue), - aFuncaoGetDescricao(aField.NewValue)]); -end; - -function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet;const sCampoChave: String; - const sCampoRetorno: String):String; -var - sDescOld, sDescNew : String; -begin - sDescOld := EmptyStr; - sDescNew := EmptyStr; - Result := EmptyStr; - if FieldHasChanged(aField) then - begin - if not ValueIsEmptyNull(aField.OldValue) then - sDescOld := oCDSLookup.Lookup(sCampoChave, aField.OldValue, sCampoRetorno); - if not ValueIsEmptyNull(aField.NewValue) then - sDescNew := oCDSLookup.Lookup(sCampoChave, aField.NewValue, sCampoRetorno); - - if (sDescOld <> EmptyStr) or (sDescNew <> EmptyStr) then - Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, sDescOld, sDescNew]); - end; -end; - -function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; -var - i : Integer; - bm : TBookmark; - aMsgReg, aMsgAlt : String; -begin - Result := EmptyStr; - if (oCDS = nil) or (not oCDS.Active) or (oCDS.RecordCount = 0) then - Exit; - bm := oCDS.Bookmark; - oCDS.DisableControls; - try - oCDS.First; - while not oCDS.Eof do - begin - aMsgReg := EmptyStr; - aMsgAlt := EmptyStr; - // loga se não for inclusão - if not ValueIsEmptyNull(oCDS.FieldByName(key).OldValue) then - begin - // Todos os Campos - if Length(aCamposLOG)=0 then - begin - for i := 0 to oCDS.FieldCount-1 do - begin - if oCDS.FieldByName(oCDS.Fields[i].FieldName).FieldKind <> fkLookup then - aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( - oCDS.FieldByName(oCDS.Fields[i].FieldName) ); - end; - end - // campos do Array - else - begin - for i := 0 to Length(aCamposLOG)-1 do - begin - aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(aCamposLOG[i]) ); - end; - end; - - if (Length(aCamposDescricao) > 0) and (aMsgAlt <> EmptyStr) then - begin - aMsgReg := EmptyStr; - for i := 0 to Length(aCamposDescricao)-1 do - begin - if aMsgReg <> EmptyStr then - aMsgReg := aMsgReg + ', '; - aMsgReg := aMsgReg + getCampoSemRTF(oCDS.FieldByName(aCamposDescricao[i]).AsString); - end; - aMsgReg := #13 + #13 + 'Alterado ' + aMsgReg; - end; - - // Copy retira uma linha no começo da mensagem dos campos - if aMsgAlt <> EmptyStr then - Result := Result + aMsgReg + Copy(aMsgAlt, 2, length(aMsgAlt)); - end; - oCDS.Next; - end; - finally - oCDS.GotoBookmark(bm); - oCDS.EnableControls; - end; -end; - -function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; - const sCampoChave: String; aCampoDescricao: Array of String): String; -begin - Result := EmptyStr; - AlteradoCDS.DisableControls; - try - // Verifica Registros Excluidos - Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS, AlteradoCDS, sCampoChave, aCampoDescricao, - 'Exclusão: '); - - // Verifica Registros Incluídos - Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(AlteradoCDS, OriginalCDS, sCampoChave, aCampoDescricao, - 'Inclusão: '); - finally - AlteradoCDS.EnableControls; - end; -end; - -function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; - const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; -var - nRegCol : Integer; - aMsgReg : String; - _Str: TStringList; - _Valor: string; -begin - Result := EmptyStr; - _Str := TStringList.Create; - try - OriginalCDS.First; - while not OriginalCDS.Eof do - begin - if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then - begin - if Length(aCampoDescricao) > 0 then - begin - aMsgReg := EmptyStr; - for nRegCol := 0 to Length(aCampoDescricao)-1 do - begin - _valor := getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); - if _valor <> EmptyStr then - _Str.Add(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).DisplayLabel + ': '+ _valor); - end; - end; - Result := Result + #13 + sDescricao + _Str.CommaText; - end; - OriginalCDS.Next; - end; - finally - FreeAndNil(_Str); - end; -end; - -function isRTFValue(vValor: Variant): Boolean; -begin - Result := False; - if not ValueIsEmptyNull(vValor) then - Result := Copy(vValor, 1, 5) = '{\rtf'; -end; - -function getCampoSemRTF(const vValor : Variant):String; -var - sValor : String; -begin - result := EmptyStr; - if not ValueIsEmptyNull(vValor) then - begin - sValor := VarToStr(vValor); - if isRTFValue(sValor) then - result := ConverteRTF(sValor) - else - result := sValor; - end; -end; - -procedure TrimAppMemorySize; -var - MainHandle : THandle; -begin - try - MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID) ; - SetProcessWorkingSetSize(MainHandle, $FFFFFFFF, $FFFFFFFF) ; - CloseHandle(MainHandle) ; - except - end; - Application.ProcessMessages; -end; - function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; begin Result := Trim(Valor); @@ -1630,44 +1121,6 @@ function Base64ToBitmap(base64Field: TBlobField): TBitmap; end; end; -procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); -var ProcInfo: TProcessInformation; - StartInfo: TStartupInfo; - FrmMensagem : TFrmMensagemAguarde; -begin - FrmMensagem := TFrmMensagemAguarde.Create(Application); - try - FrmMensagem.Show; - FrmMensagem.setMensagem('Aguarde, Carregando... ', True); - FrmMensagem.Update; - - {https://msdn.microsoft.com/en-us/library/ms686331.aspx} - FillMemory(@StartInfo, SizeOf(StartInfo), 0); - StartInfo.cb := SizeOf(StartInfo); - StartInfo.dwFlags := STARTF_RUNFULLSCREEN; - StartInfo.wShowWindow := SW_SHOWMAXIMIZED; - StartInfo.dwXSize := Screen.Width; - StartInfo.dwYSize := Screen.Height; - StartInfo.dwX := 0; - StartInfo.dwY := 0; - - CreateProcess( - nil, - PChar(FileName), - nil, Nil, False, - DEBUG_PROCESS and CREATE_NEW_CONSOLE and CREATE_NEW_PROCESS_GROUP and BELOW_NORMAL_PRIORITY_CLASS, - nil, nil, - StartInfo, - ProcInfo); - CloseHandle(ProcInfo.hProcess); - CloseHandle(ProcInfo.hThread); - finally - SleepEx(SleepInterval, False); - FrmMensagem.Close; - FrmMensagem.Release; - end; -end; - function TestConection(const url: String): boolean; var HTTPClient: TidHTTP; @@ -1701,26 +1154,6 @@ function TestConection(const url: String): boolean; end; end; -function GetPageAsString(const url: String): String; -var - lHTTP: TIdHTTP; - lUri: TIdURI; -begin - Result := EmptyStr; - - if TestConection(url) then - begin - lHTTP := TIdHTTP.Create(Application); - lUri := TIdUri.Create; - try - Result := lHTTP.Get(lUri.URLEncode(url)); - finally - FreeAndNil(lHTTP); - FreeAndNil(lUri); - end; - end; -end; - function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; var @@ -1919,11 +1352,6 @@ function GetPowerStatus: string; Result := 'AC power offline'; end; -function GetPrinters: string; -begin - Result := Printer.Printers.Text; -end; - function GetSystemDecimal: string; var MyDecimal: PChar; @@ -1954,28 +1382,6 @@ function GetPcName: string; Result := StrPas(CompName); end; -function GetProcessList: string; -var - Wnd: hWnd; - Buff: array [0..127] of Char; -begin - Result := EmptyStr; - - Wnd:=GetWindow(Application.Handle, gw_HWndFirst); - while Wnd<>0 do - begin - if (Wnd<>Application.Handle) and - IsWindowVisible(Wnd) and - (GetWindow(Wnd, gw_Owner)=0) and - (GetWindowText(Wnd, Buff, sizeof(buff))<>0) then - begin - GetWindowText(Wnd, Buff, SizeOf(Buff)); - Result := Result + #13#10 + StrPas(Buff) + 'Memória: ' + IntToStr(getMemoryUsed); - end; - Wnd:=GetWindow(Wnd, gw_hWndNext); - end; -end; - function getMemoryUsed: Integer; var pmc: PROCESS_MEMORY_COUNTERS; @@ -2056,45 +1462,6 @@ function GetLanguage: string; Result := string(Lang); end; -function GetSystemInfo: string; -begin - Result := 'INFORMAÇÕES DO SISTEMA:'; - Result := Result + #13#10 + '---------------------------------------------------------------------------'; - Result := Result + #13#10 + 'Mac Address: ' + GetMacAddress; - Result := Result + #13#10 + 'Diretório do Windows: ' + GetWindowsDir; - Result := Result + #13#10 + 'Nome do Computador: ' + GetPcName; - Result := Result + #13#10 + 'Impressoras: ' + #13#10 + GetPrinters; - Result := Result + #13#10 + 'Versão do Windows: ' + GetWindowsVersion; - Result := Result + #13#10 + 'Idioma: ' + GetLanguage; - Result := Result + #13#10 + 'Estado do Scroll: ' + GetScrollState; - Result := Result + #13#10 + 'Resolução da Tela: ' + ScreenResolution; - Result := Result + #13#10 + 'Espaço Livre no C: ' + FreeDiskSpace('C'); - Result := Result + #13#10 + 'Horário do Windows: ' + TimeInWindows; - Result := Result + #13#10 + 'Estado de Energia: ' + GetPowerStatus; - Result := Result + #13#10 + 'Usuário: ' + GetUser; - Result := Result + #13#10 + 'Lista de Processos: ' + GetProcessList; - Result := Result + #13#10 + '---------------------------------------------------------------------------'; - //Result := GetSystemDecimal; -end; - -function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; -begin - Result := FHWND; - - if Trim(ATaskName) <> EmptyStr then - begin - FTaskName := ATaskName; - FPid := PDWORD_PTR(GetWindowPID(ATaskName)); - FProcessa := True; - if not EnumWindows(@EnumProcess, iListOfProcess) then - Exit - else - Application.ProcessMessages; - - Result := FHWND; - end; -end; function GetWindowPID(sFile: String): Cardinal; var @@ -2198,57 +1565,6 @@ function EnumWindowsProc (Wnd: HWND; List: TStringList): BOOL; stdcall; List.AddObject(Caption, TObject(Wnd)); end; -function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; -var - ContinueLoop: BOOL; - FSnapshotHandle: THandle; - FProcessEntry32: TProcessEntry32; -begin - FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); - try - FProcessEntry32.dwSize := SizeOf(FProcessEntry32); - ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); - Result := False; - while Integer(ContinueLoop) <> 0 do - begin - if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = - UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = - UpperCase(ExeFileName))) then - begin - Result := True; - ValidaTravamento(UpperCase(ExeFileName), FTaskName, FPid, FProcessa, FHWND, iListOfProcess); - end; - ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); - end; - finally - CloseHandle(FSnapshotHandle); - end; -end; - -function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; -var - dwResult: PDWORD_PTR; - ValorRetorno: Longint; - AppHandle : THandle; -begin - Result := False; - - try - AppHandle:= UtilsUnit.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); - if AppHandle <> 0 then - begin - ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, - SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); - if ValorRetorno > 0 then - Result := True - else - Result := False; - end; - except - end; -end; function KillTask(const ExeFileName: string): Integer; const @@ -2401,76 +1717,42 @@ function GetTelaAprovacao(conn: TosSQLConnection) : string; end; end; -procedure ExecuteAndWait(const aCommando: string); +function LocalIp: string; var - tmpStartupInfo: TStartupInfo; - tmpProcessInformation: TProcessInformation; - tmpProgram: String; + IPW: TIdIPWatch; begin - tmpProgram := trim(aCommando); - FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); - with tmpStartupInfo do - begin - cb := SizeOf(TStartupInfo); - wShowWindow := SW_HIDE; - end; + Result := '127.0.0.1'; - if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, - nil, nil, tmpStartupInfo, tmpProcessInformation) then - begin - // loop every 10 ms - while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do - begin - Application.ProcessMessages; - end; - CloseHandle(tmpProcessInformation.hProcess); - CloseHandle(tmpProcessInformation.hThread); - end - else - begin - RaiseLastOSError; + IpW := TIdIPWatch.Create(nil); + try + IpW.Active := True; + if IpW.LocalIP <> EmptyStr then + Result := FormatIP(IpW.LocalIP); + finally + if Assigned(IpW) then + FreeAndNil(IpW); end; end; -function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +function GetPageAsString(const url: String): String; var - tmpStartupInfo: TStartupInfo; - tmpProgram: String; + lHTTP: TIdHTTP; + lUri: TIdURI; begin - tmpProgram := trim(aCommando); - FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); - with tmpStartupInfo do - begin - cb := SizeOf(TStartupInfo); - wShowWindow := SW_HIDE; - end; - - if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW or CREATE_DEFAULT_ERROR_MODE, - nil, nil, tmpStartupInfo, aProcessInformation) then - Result := True - else - begin - Result := False; - RaiseLastOSError; - end; -end; + Result := EmptyStr; -procedure WaitProcess(const aProcessInformation: TProcessInformation); -begin - // loop every 10 ms - while WaitForSingleObject(aProcessInformation.hProcess, 10) > 0 do + if TestConection(url) then begin - Application.ProcessMessages; + lHTTP := TIdHTTP.Create(nil); + lUri := TIdUri.Create; + try + Result := lHTTP.Get(lUri.URLEncode(url)); + finally + FreeAndNil(lHTTP); + FreeAndNil(lUri); + end; end; - CloseProcess(aProcessInformation); end; -procedure CloseProcess(const aProcessInformation: TProcessInformation); -begin - CloseHandle(aProcessInformation.hProcess); - CloseHandle(aProcessInformation.hThread); -end; - - end. diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas new file mode 100644 index 0000000..8e17385 --- /dev/null +++ b/Lib/UtilsUnitGUI.pas @@ -0,0 +1,730 @@ +unit UtilsUnitGUI; + +interface + +uses + Forms, Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, + wwdbedit, acSysUtils, Printers, osComboSearch, System.Classes, DB, DBClient, Winapi.PsApi, Winapi.Windows, + Vcl.Graphics, ShellAPI, UMensagemAguarde, SysUtils, UtilsUnit, Variants, Winapi.Messages, Winapi.TlHelp32; + +type + varArrayOfcomps = array of TComponent; + TFuncaoParametroGetDesc = function(const vValor : Variant) : string; + +const + CSIDL_COMMON_APPDATA = $0023; + +procedure setHabilitaDBEdit(edt: TDBEdit; enabled: boolean); +procedure setHabilitaButton(btn: TButton; enabled: boolean); +procedure setHabilitaSpeedButton(btn: TSpeedButton; enabled: boolean); +procedure setHabilitawwComboBox(comboBox: TwwDBComboBox; enabled: boolean); +procedure setHabilitaComboBox(comboBox: TComboBox; enabled: boolean); +procedure setHabilitawwDateTimePicker(dateTimePicker: TwwDBDateTimePicker; enabled: boolean); +procedure setHabilitaDBCheckBox(edtd: TDBCheckBox; enabled: boolean); +procedure setHabilitaDBMemo(comp: TDBMemo; enabled: boolean); +procedure setHabilitawwDBGrid(grd: TwwDBGrid; enabled: boolean); +procedure setHabilitaEdit(edit: TEdit; enabled: boolean); +procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); +procedure setHabilitaComponente(comp: TComponent; enabled: boolean); +procedure habilitaComponentes(comps: varArrayOfcomps); +procedure desHabilitaComponentes(comps: array of TComponent); +procedure ImprimirImpressoraTermica(const comando, impressora: String); +function ConverteRTF(rtf: string): string; +function ConverteTextoToRTF(Texto: string): string; +function getCampoSemRTF(const vValor : Variant):String; +function CriarMsgLogAlteracaoField(aField : TField):String; overload; +function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; +function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet; + const sCampoChave: String; const sCampoRetorno: String):String; +function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; +function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String): String; +function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; +function isRTFValue(vValor: Variant): Boolean; //{\rtf +procedure TrimAppMemorySize; +procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); +function GetPrinters: string; +function GetProcessList: string; +function GetSystemInfo: string; +function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; +procedure ExecuteAndWait(const aCommando: string); +function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +procedure WaitProcess(const aProcessInformation: TProcessInformation); +procedure CloseProcess(const aProcessInformation: TProcessInformation); +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; + + +implementation + +procedure setHabilitaButton(btn: TButton; enabled: boolean); +begin + btn.Enabled := enabled; +end; + +procedure setHabilitaSpeedButton(btn: TSpeedButton; enabled: boolean); +begin + btn.Enabled := enabled; +end; + +procedure setHabilitaDBEdit(edt: TDBEdit; enabled: boolean); +begin + if enabled then + begin + edt.ReadOnly := false; + edt.color := clWhite; + end + else + begin + edt.ReadOnly := true; + edt.color := clBtnFace; + end; +end; + +procedure setHabilitawwComboBox(comboBox: TwwDBComboBox; enabled: boolean); +begin + if enabled then + begin + comboBox.ReadOnly := false; + comboBox.Color := clWhite; + end + else + begin + comboBox.ReadOnly := true; + comboBox.Color := clBtnFace; + end; +end; + +procedure setHabilitaComboBox(comboBox: TComboBox; enabled: boolean); +begin + if enabled then + begin + comboBox.Enabled := True; + comboBox.Color := clWhite; + end + else + begin + comboBox.Enabled := False; + comboBox.Color := clBtnFace; + end; +end; + +procedure setHabilitawwDateTimePicker(dateTimePicker: TwwDBDateTimePicker; enabled: boolean); +begin + if enabled then + begin + dateTimePicker.ReadOnly := false; + dateTimePicker.Color := clWhite; + end + else + begin + dateTimePicker.ReadOnly := true; + dateTimePicker.Color := clBtnFace; + end; +end; + +procedure setHabilitaDBCheckBox(edtd: TDBCheckBox; enabled: boolean); +begin + if enabled then + begin + edtd.ReadOnly := false; + end + else + begin + edtd.ReadOnly := true; + end; +end; + +procedure setHabilitawwDBGrid(grd: TwwDBGrid; enabled: boolean); +begin + if enabled then + begin + grd.ReadOnly := false; + end + else + begin + grd.ReadOnly := true; + end; +end; + + +procedure setHabilitaDBMemo(comp: TDBMemo; enabled: boolean); +begin + if enabled then + begin + comp.enabled := true; + comp.Color := clWhite; + end + else + begin + comp.enabled := false; + comp.Color := clBtnFace; + end; +end; + +procedure setHabilitaComponente(comp: TComponent; enabled: boolean); +begin + if comp is TosComboSearch then + setHabilitaComboSearch((comp as TosComboSearch), enabled); + if comp is TDBEdit then + setHabilitaDBEdit((comp as TDBEdit), enabled); + if comp is TwwDBComboBox then + setHabilitawwComboBox((comp as TwwDBComboBox), enabled); + if comp is TwwDBDateTimePicker then + setHabilitawwDateTimePicker((comp as TwwDBDateTimePicker), enabled); + if comp is TDBCheckBox then + setHabilitadbCheckBox((comp as TDBCheckBox), enabled); + if comp is TDBMemo then + setHabilitaDBMemo((comp as TDBMemo), enabled); + if comp is TwwDBGrid then + setHabilitawwDBGrid((comp as twwDBGrid), enabled); + if comp is TButton then + setHabilitaButton((comp as TButton), enabled); + if comp is TSpeedButton then + setHabilitaSpeedButton((comp as TSpeedButton), enabled); +end; + +procedure habilitaComponentes(comps: varArrayOfcomps); +var + i: integer; +begin + for i := low(comps) to high(comps) do + setHabilitaComponente(comps[i], true); +end; + +procedure desHabilitaComponentes(comps: array of TComponent); +var + i: integer; +begin + for i := low(comps) to high(comps) do + setHabilitaComponente(comps[i], false); +end; + +procedure setHabilitaEdit(edit: TEdit; enabled: boolean); +begin + if enabled then + begin + edit.ReadOnly := false; + edit.Color := clWhite; + end + else + begin + edit.ReadOnly := true; + edit.Color := clBtnFace; + end; +end; + +procedure ImprimirImpressoraTermica(const comando, impressora: String); +var + FBat, FComando: TextFile; + diretorio: string; +begin + diretorio:= GetSpecialFolderLocation(Application.Handle, CSIDL_COMMON_APPDATA) + '\'; + + SysUtils.DeleteFile(diretorio + 'COMANDO.TXT'); + SysUtils.DeleteFile(diretorio + 'PRINTLBL.BAT'); + + AssignFile(FComando, diretorio + 'COMANDO.TXT'); + try + Rewrite(FComando); + Writeln(FComando, comando); + finally + CloseFile(FComando); + end; + + AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); + try + Rewrite(FBat); + Writeln(FBat, 'TYPE "' + diretorio + 'COMANDO.TXT" > "'+impressora+'"'); + finally + CloseFile(FBat); + end; + + ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); +end; + +function ConverteRTF(rtf: string): string; +var + form: TForm; + richEdit: TRichEdit; + ss: TStringStream; +begin + try + ss := TStringStream.Create(rtf); + form := TForm.Create(nil); + richEdit := TRichEdit.Create(form); + richEdit.Parent := form; + richEdit.Lines.LoadFromStream(ss); + richEdit.PlainText := True; + Result := richEdit.Text; + finally + FreeAndNil(ss); + FreeAndNil(richEdit); + FreeAndNil(form); + end; +end; + +function ConverteTextoToRTF(Texto: string): string; +var + form: TForm; + richEdit: TRichEdit; + ss: TStringStream; +begin + if not isRTFValue(Texto) then + begin + try + ss := TStringStream.Create(Texto); + form := TForm.Create(nil); + richEdit := TRichEdit.Create(form); + richEdit.Parent := form; + richEdit.Text:= Texto; + richEdit.PlainText := False; + richEdit.Lines.SaveToStream(ss); + Result := ss.DataString; + finally + FreeAndNil(ss); + FreeAndNil(richEdit); + FreeAndNil(form); + end; + end; +end; + +function getCampoSemRTF(const vValor : Variant):String; +var + sValor : String; +begin + result := EmptyStr; + if not ValueIsEmptyNull(vValor) then + begin + sValor := VarToStr(vValor); + if isRTFValue(sValor) then + result := ConverteRTF(sValor) + else + result := sValor; + end; +end; + +function CriarMsgLogAlteracaoField(aField : TField):String; overload; +begin + Result := EmptyStr; + if FieldHasChanged(aField) then + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), + getCampoSemRTF(aField.NewValue)]); + +end; + +function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; +begin + Result := EmptyStr; + if FieldHasChanged(aField) then + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, aFuncaoGetDescricao(aField.OldValue), + aFuncaoGetDescricao(aField.NewValue)]); +end; + +function CriarMsgLogAlteracaoFieldLookup(aField : TField; oCDSLookup: TClientDataSet;const sCampoChave: String; + const sCampoRetorno: String):String; +var + sDescOld, sDescNew : String; +begin + sDescOld := EmptyStr; + sDescNew := EmptyStr; + Result := EmptyStr; + if FieldHasChanged(aField) then + begin + if not ValueIsEmptyNull(aField.OldValue) then + sDescOld := oCDSLookup.Lookup(sCampoChave, aField.OldValue, sCampoRetorno); + if not ValueIsEmptyNull(aField.NewValue) then + sDescNew := oCDSLookup.Lookup(sCampoChave, aField.NewValue, sCampoRetorno); + + if (sDescOld <> EmptyStr) or (sDescNew <> EmptyStr) then + Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, sDescOld, sDescNew]); + end; +end; + +function CriarMsgLogAlteracaoCDS(oCDS: TClientDataSet; key: string; aCamposDescricao, aCamposLOG: Array of String): String; +var + i : Integer; + bm : TBookmark; + aMsgReg, aMsgAlt : String; +begin + Result := EmptyStr; + if (oCDS = nil) or (not oCDS.Active) or (oCDS.RecordCount = 0) then + Exit; + bm := oCDS.Bookmark; + oCDS.DisableControls; + try + oCDS.First; + while not oCDS.Eof do + begin + aMsgReg := EmptyStr; + aMsgAlt := EmptyStr; + // loga se não for inclusão + if not ValueIsEmptyNull(oCDS.FieldByName(key).OldValue) then + begin + // Todos os Campos + if Length(aCamposLOG)=0 then + begin + for i := 0 to oCDS.FieldCount-1 do + begin + if oCDS.FieldByName(oCDS.Fields[i].FieldName).FieldKind <> fkLookup then + aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( + oCDS.FieldByName(oCDS.Fields[i].FieldName) ); + end; + end + // campos do Array + else + begin + for i := 0 to Length(aCamposLOG)-1 do + begin + aMsgAlt := aMsgAlt + CriarMsgLogAlteracaoField( oCDS.FieldByName(aCamposLOG[i]) ); + end; + end; + + if (Length(aCamposDescricao) > 0) and (aMsgAlt <> EmptyStr) then + begin + aMsgReg := EmptyStr; + for i := 0 to Length(aCamposDescricao)-1 do + begin + if aMsgReg <> EmptyStr then + aMsgReg := aMsgReg + ', '; + aMsgReg := aMsgReg + getCampoSemRTF(oCDS.FieldByName(aCamposDescricao[i]).AsString); + end; + aMsgReg := #13 + #13 + 'Alterado ' + aMsgReg; + end; + + // Copy retira uma linha no começo da mensagem dos campos + if aMsgAlt <> EmptyStr then + Result := Result + aMsgReg + Copy(aMsgAlt, 2, length(aMsgAlt)); + end; + oCDS.Next; + end; + finally + oCDS.GotoBookmark(bm); + oCDS.EnableControls; + end; +end; + +function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String): String; +begin + Result := EmptyStr; + AlteradoCDS.DisableControls; + try + // Verifica Registros Excluidos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS, AlteradoCDS, sCampoChave, aCampoDescricao, + 'Exclusão: '); + + // Verifica Registros Incluídos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(AlteradoCDS, OriginalCDS, sCampoChave, aCampoDescricao, + 'Inclusão: '); + finally + AlteradoCDS.EnableControls; + end; +end; + +function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; + const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; +var + nRegCol : Integer; + aMsgReg : String; + _Str: TStringList; + _Valor: string; +begin + Result := EmptyStr; + _Str := TStringList.Create; + try + OriginalCDS.First; + while not OriginalCDS.Eof do + begin + if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then + begin + if Length(aCampoDescricao) > 0 then + begin + aMsgReg := EmptyStr; + for nRegCol := 0 to Length(aCampoDescricao)-1 do + begin + _valor := getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); + if _valor <> EmptyStr then + _Str.Add(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).DisplayLabel + ': '+ _valor); + end; + end; + Result := Result + #13 + sDescricao + _Str.CommaText; + end; + OriginalCDS.Next; + end; + finally + FreeAndNil(_Str); + end; +end; + +function isRTFValue(vValor: Variant): Boolean; +begin + Result := False; + if not ValueIsEmptyNull(vValor) then + Result := Copy(vValor, 1, 5) = '{\rtf'; +end; + +procedure TrimAppMemorySize; +var + MainHandle : THandle; +begin + try + MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID) ; + SetProcessWorkingSetSize(MainHandle, $FFFFFFFF, $FFFFFFFF) ; + CloseHandle(MainHandle) ; + except + end; + Application.ProcessMessages; +end; + +procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); +var ProcInfo: TProcessInformation; + StartInfo: TStartupInfo; + FrmMensagem : TFrmMensagemAguarde; +begin + FrmMensagem := TFrmMensagemAguarde.Create(Application); + try + FrmMensagem.Show; + FrmMensagem.setMensagem('Aguarde, Carregando... ', True); + FrmMensagem.Update; + + {https://msdn.microsoft.com/en-us/library/ms686331.aspx} + FillMemory(@StartInfo, SizeOf(StartInfo), 0); + StartInfo.cb := SizeOf(StartInfo); + StartInfo.dwFlags := STARTF_RUNFULLSCREEN; + StartInfo.wShowWindow := SW_SHOWMAXIMIZED; + StartInfo.dwXSize := Screen.Width; + StartInfo.dwYSize := Screen.Height; + StartInfo.dwX := 0; + StartInfo.dwY := 0; + + CreateProcess( + nil, + PChar(FileName), + nil, Nil, False, + DEBUG_PROCESS and CREATE_NEW_CONSOLE and CREATE_NEW_PROCESS_GROUP and BELOW_NORMAL_PRIORITY_CLASS, + nil, nil, + StartInfo, + ProcInfo); + CloseHandle(ProcInfo.hProcess); + CloseHandle(ProcInfo.hThread); + finally + SleepEx(SleepInterval, False); + FrmMensagem.Close; + FrmMensagem.Release; + end; +end; + +function GetPrinters: string; +begin + Result := Printer.Printers.Text; +end; + +function GetProcessList: string; +var + Wnd: hWnd; + Buff: array [0..127] of Char; +begin + Result := EmptyStr; + + Wnd:=GetWindow(Application.Handle, gw_HWndFirst); + while Wnd<>0 do + begin + if (Wnd<>Application.Handle) and + IsWindowVisible(Wnd) and + (GetWindow(Wnd, gw_Owner)=0) and + (GetWindowText(Wnd, Buff, sizeof(buff))<>0) then + begin + GetWindowText(Wnd, Buff, SizeOf(Buff)); + Result := Result + #13#10 + StrPas(Buff) + 'Memória: ' + IntToStr(getMemoryUsed); + end; + Wnd:=GetWindow(Wnd, gw_hWndNext); + end; +end; + +function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; +begin + Result := FHWND; + + if Trim(ATaskName) <> EmptyStr then + begin + FTaskName := ATaskName; + FPid := PDWORD_PTR(GetWindowPID(ATaskName)); + FProcessa := True; + if not EnumWindows(@EnumProcess, iListOfProcess) then + Exit + else + Application.ProcessMessages; + + Result := FHWND; + end; +end; + +procedure ExecuteAndWait(const aCommando: string); +var + tmpStartupInfo: TStartupInfo; + tmpProcessInformation: TProcessInformation; + tmpProgram: String; +begin + tmpProgram := trim(aCommando); + FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); + with tmpStartupInfo do + begin + cb := SizeOf(TStartupInfo); + wShowWindow := SW_HIDE; + end; + + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, + nil, nil, tmpStartupInfo, tmpProcessInformation) then + begin + // loop every 10 ms + while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do + begin + Application.ProcessMessages; + end; + CloseHandle(tmpProcessInformation.hProcess); + CloseHandle(tmpProcessInformation.hThread); + end + else + begin + RaiseLastOSError; + end; +end; + +function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +var + tmpStartupInfo: TStartupInfo; + tmpProgram: String; +begin + tmpProgram := trim(aCommando); + FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); + with tmpStartupInfo do + begin + cb := SizeOf(TStartupInfo); + wShowWindow := SW_HIDE; + end; + + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW or CREATE_DEFAULT_ERROR_MODE, + nil, nil, tmpStartupInfo, aProcessInformation) then + Result := True + else + begin + Result := False; + RaiseLastOSError; + end; +end; + +procedure WaitProcess(const aProcessInformation: TProcessInformation); +begin + // loop every 10 ms + while WaitForSingleObject(aProcessInformation.hProcess, 10) > 0 do + begin + Application.ProcessMessages; + end; + CloseProcess(aProcessInformation); +end; + +procedure CloseProcess(const aProcessInformation: TProcessInformation); +begin + CloseHandle(aProcessInformation.hProcess); + CloseHandle(aProcessInformation.hThread); +end; + +function GetSystemInfo: string; +begin + Result := 'INFORMAÇÕES DO SISTEMA:'; + Result := Result + #13#10 + '---------------------------------------------------------------------------'; + Result := Result + #13#10 + 'Mac Address: ' + GetMacAddress; + Result := Result + #13#10 + 'Diretório do Windows: ' + GetWindowsDir; + Result := Result + #13#10 + 'Nome do Computador: ' + GetPcName; + Result := Result + #13#10 + 'Impressoras: ' + #13#10 + GetPrinters; + Result := Result + #13#10 + 'Versão do Windows: ' + GetWindowsVersion; + Result := Result + #13#10 + 'Idioma: ' + GetLanguage; + Result := Result + #13#10 + 'Estado do Scroll: ' + GetScrollState; + Result := Result + #13#10 + 'Resolução da Tela: ' + ScreenResolution; + Result := Result + #13#10 + 'Espaço Livre no C: ' + FreeDiskSpace('C'); + Result := Result + #13#10 + 'Horário do Windows: ' + TimeInWindows; + Result := Result + #13#10 + 'Estado de Energia: ' + GetPowerStatus; + Result := Result + #13#10 + 'Usuário: ' + GetUser; + Result := Result + #13#10 + 'Lista de Processos: ' + GetProcessList; + Result := Result + #13#10 + '---------------------------------------------------------------------------'; + //Result := GetSystemDecimal; +end; + +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; +var + dwResult: PDWORD_PTR; + ValorRetorno: Longint; + AppHandle : THandle; +begin + Result := False; + + try + AppHandle:= UtilsUnitGui.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + if AppHandle <> 0 then + begin + ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, + SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); + if ValorRetorno > 0 then + Result := True + else + Result := False; + end; + except + end; +end; + +procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); +begin + if enabled then + begin + cbo.ReadOnly := false; + cbo.color := clWhite; + cbo.showButton := true; + end + else + begin + cbo.ReadOnly := true; + cbo.color := clBtnFace; + cbo.showButton := false; + end; + cbo.invalidate; +end; + +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + try + FProcessEntry32.dwSize := SizeOf(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + Result := False; + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = + UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = + UpperCase(ExeFileName))) then + begin + Result := True; + ValidaTravamento(UpperCase(ExeFileName), FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + finally + CloseHandle(FSnapshotHandle); + end; +end; + + +end. + From 9315c3065253cc542c23892fe21e08a8358e59b2 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 21 Dec 2017 13:52:52 -0200 Subject: [PATCH 150/294] Ticket_id: #64305 - Creation flags --- Lib/UtilsUnitGUI.pas | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 8e17385..b2ab163 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -52,7 +52,7 @@ function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; procedure ExecuteAndWait(const aCommando: string); -function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +function Execute(const aCommando: string; const ShowWindow: boolean; var aProcessInformation: TProcessInformation): boolean; procedure WaitProcess(const aProcessInformation: TProcessInformation); procedure CloseProcess(const aProcessInformation: TProcessInformation); function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; @@ -596,10 +596,11 @@ procedure ExecuteAndWait(const aCommando: string); end; end; -function Execute(const aCommando: string; var aProcessInformation: TProcessInformation): boolean; +function Execute(const aCommando: string; const ShowWindow: boolean; var aProcessInformation: TProcessInformation): boolean; var tmpStartupInfo: TStartupInfo; tmpProgram: String; + CreationFlags: Cardinal; begin tmpProgram := trim(aCommando); FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); @@ -608,8 +609,11 @@ function Execute(const aCommando: string; var aProcessInformation: TProcessInfor cb := SizeOf(TStartupInfo); wShowWindow := SW_HIDE; end; - - if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW or CREATE_DEFAULT_ERROR_MODE, + if ShowWindow then + CreationFlags := NORMAL_PRIORITY_CLASS + else + CreationFlags := CREATE_NO_WINDOW or CREATE_DEFAULT_ERROR_MODE; + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CreationFlags, nil, nil, tmpStartupInfo, aProcessInformation) then Result := True else From 1718758bc4374fbc2616a7ce909f3bd52a7abcfa Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 8 Jan 2018 09:58:31 -0200 Subject: [PATCH 151/294] =?UTF-8?q?Ticket=5Fid:=20#64595=20-=20Novas=20fun?= =?UTF-8?q?=C3=A7=C3=B5es=20para=20verifica=C3=A7=C3=A3o=20de=20pastas=20l?= =?UTF-8?q?ocais?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d2cdb68..8fa04ba 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,7 +8,7 @@ interface Classes, Math, RegExpr, DB, DBClient, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, - Vcl.Graphics, Winapi.Messages; + Vcl.Graphics, Winapi.Messages, SHFolder; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -111,6 +111,8 @@ function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; function GetTelaAprovacao(conn: TosSQLConnection) : string; +function GetSpecialFolderPath(const folder : integer) : string; +function GetLocalAppDataFolder: string; implementation @@ -1736,5 +1738,22 @@ function GetPageAsString(const url: String): String; end; end; +function GetSpecialFolderPath(const folder : integer) : string; + const + SHGFP_TYPE_CURRENT = 0; + var + path: array [0..MAX_PATH] of char; + begin + if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then + Result := path + else + Result := ''; + end; + +function GetLocalAppDataFolder: string; +begin + Result := GetSpecialFolderPath(CSIDL_LOCAL_APPDATA); +end; + end. From f18a7d08704d29ec515754378ff11751a7c4c642 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 9 Jan 2018 16:09:31 -0200 Subject: [PATCH 152/294] Ticket_id: #64595 - TEnconding.UTF8 no stringStream --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8fa04ba..1748a2e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1128,7 +1128,7 @@ function TestConection(const url: String): boolean; Stream: TStringStream; LHandler: TIdSSLIOHandlerSocketOpenSSL; begin - Stream := TStringStream.Create(''); + Stream := TStringStream.Create('', TEncoding.UTF8); HTTPClient := TidHTTP.Create(nil); LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTPClient); From 91cef52c00f262d0c6dc2975ec83453ca4d5dfe0 Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 15 Jan 2018 09:29:01 -0200 Subject: [PATCH 153/294] =?UTF-8?q?Ticket=5Fid:=20#64595=20-=20M=C3=A9todo?= =?UTF-8?q?s=20pertinentes=20ao=20CheckIsAlive?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnitGUI.pas | 72 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 68 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 85c826b..26244a3 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -5,7 +5,8 @@ interface uses Forms, Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, wwdbedit, acSysUtils, Printers, osComboSearch, System.Classes, DB, DBClient, Winapi.PsApi, Winapi.Windows, - Vcl.Graphics, ShellAPI, UMensagemAguarde, SysUtils, UtilsUnit, Variants, Winapi.Messages, Winapi.TlHelp32; + Vcl.Graphics, ShellAPI, UMensagemAguarde, SysUtils, UtilsUnit, Variants, Winapi.Messages, Winapi.TlHelp32, + Winsock; type varArrayOfcomps = array of TComponent; @@ -53,7 +54,7 @@ function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FP var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; procedure ExecuteAndWait(const aCommando: string); function Execute(const aCommando: string; const ShowWindow: boolean; var aProcessInformation: TProcessInformation): boolean; -procedure WaitProcess(const aProcessInformation: TProcessInformation); +procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); procedure CloseProcess(const aProcessInformation: TProcessInformation); function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; @@ -61,7 +62,7 @@ function LocalIp: string; implementation -uses IdIPWatch; +uses IdIPWatch, IdTCPClient; procedure setHabilitaButton(btn: TButton; enabled: boolean); begin @@ -625,12 +626,75 @@ function Execute(const aCommando: string; const ShowWindow: boolean; var aProces end; end; -procedure WaitProcess(const aProcessInformation: TProcessInformation); +function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean; +var + client : sockaddr_in; + sock : Integer; + + ret : Integer; + wsdata : WSAData; +begin + Result:=False; + ret := WSAStartup($0002, wsdata); //initiates use of the Winsock DLL + if ret<>0 then exit; + try + client.sin_family := AF_INET; //Set the protocol to use , in this case (IPv4) + client.sin_port := htons(dwPort); //convert to TCP/IP network byte order (big-endian) + client.sin_addr.s_addr := inet_addr(PAnsiChar(ipAddressStr)); //convert to IN_ADDR structure + sock :=socket(AF_INET, SOCK_STREAM, 0); //creates a socket + Result:=connect(sock,client,SizeOf(client))=0; //establishes a connection to a specified socket + finally + WSACleanup; + end; +end; + +function SendMessageToTCPServer(const aMessage: string; aPort: integer): boolean; +var + IdTCP: TIdTCPClient; + msg: string; +begin + Result := False; + try + IdTCP := TIdTCPClient.Create(nil); + try + IdTCP.Host := '127.0.0.1'; + IdTCP.Port := aPort; + IdTCP.ConnectTimeout := 3000; + IdTCP.Connect; + + if IdTCP.Connected then + begin + IdTCP.IOHandler.WriteLn(aMessage); + IdTCP.IOHandler.ReadTimeout := 500; + msg := IdTCP.IOHandler.Readln; + end; + + finally + IdTCP.Disconnect; + FreeAndNil(IdTCP); + end; + Result := True; + except + + end; +end; + +procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); +var + copyDataStruct : TCopyDataStruct; + StringToSend: string; + handle: THandle; begin // loop every 10 ms while WaitForSingleObject(aProcessInformation.hProcess, 10) > 0 do begin Application.ProcessMessages; + if aCheckIsAlive then + begin + StringToSend := Format('{"ThreadId":%d,"ProcessId":%d}', [aThreadId, aProcessInformation.dwProcessId]); + if not SendMessageToTCPServer(StringToSend, aPort) then + TerminateProcess(aProcessInformation.hProcess , 0); + end; end; CloseProcess(aProcessInformation); end; From 9243ab8229b98b1efd02f3a5ce9e4cf6d46473d9 Mon Sep 17 00:00:00 2001 From: Wellington Torrejais da Silva Date: Tue, 16 Jan 2018 11:48:13 -0200 Subject: [PATCH 154/294] Ticket_id: #63380 - Ajuste na funcao de Encode Base64 de binarios Signed-off-by: Wellington Torrejais da Silva --- Lib/UtilsUnit.pas | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 43f9d0f..af8072e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,7 +8,7 @@ interface Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics, - IdHashSHA; + IdHashSHA, IdCoderMIME; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -158,7 +158,7 @@ function GetFileSize(const filename: widestring): Int64; implementation uses DateUtils, Variants, StatusUnit, UMensagemAguarde, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, - IdHash, IdHashMessageDigest, IdGlobal, IdURI, IdIPWatch; + IdHash, IdHashMessageDigest, IdGlobal, IdURI, IdIPWatch, IdCoder; const CSIDL_COMMON_APPDATA = $0023; @@ -1495,24 +1495,29 @@ function KeyToStr(Key:Word): String; end; end; + function Base64FromBinary(const FileName: String): string; var - Input: TBytesStream; - Output: TStringStream; + Input: TFileStream; + InputMemoryStream: TMemoryStream; + Output: UTF8String; + Encoder: TIdEncoderMIME; begin - Input := TBytesStream.Create; + Result := EmptyStr; + Output := EmptyStr; + + Input := TFileStream.Create(FileName, fmOpenRead); + InputMemoryStream := TMemoryStream.Create(); + Encoder := TIdEncoderMIME.Create(); try - Input.LoadFromFile(FileName); - Input.Position := 0; - Output := TStringStream.Create('', TEncoding.ASCII); - try - Soap.EncdDecd.EncodeStream(Input, Output); - Result := Output.DataString; - finally - Output.Free; - end; + //Soap.EncdDecd.EncodeStream(Input, Output); + InputMemoryStream.LoadFromStream(Input); + Output := Encoder.EncodeStream(InputMemoryStream, InputMemoryStream.Size); + Result := Output; finally - Input.Free; + FreeAndNil(Input); + FreeAndNil(InputMemoryStream); + FreeAndNil(Encoder); end; end; From 9224d0076db4494988ef75012feeef7058f74cc8 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 16 Jan 2018 15:59:56 -0200 Subject: [PATCH 155/294] =?UTF-8?q?Ticket=5Fid:=20#64430=20-=20Ao=20clicar?= =?UTF-8?q?=20no=20bot=C3=A3o=20"Delete"=20estava=20levantando=20exce?= =?UTF-8?q?=C3=A7=C3=A3o.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomMainFrm.pas | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 631134e..2731e0c 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -423,9 +423,12 @@ procedure TosCustomMainForm.DeleteActionExecute(Sender: TObject); begin inherited; Form := FCurrentEditForm; - Form.VisibleButtons := [vbExcluir, vbFechar]; - if Form.Delete('ID', FIdField.AsInteger) then - ExecLastFilter; + if Form <> nil then + begin + Form.VisibleButtons := [vbExcluir, vbFechar]; + if Form.Delete('ID', FIdField.AsInteger) then + ExecLastFilter; + end; end; procedure TosCustomMainForm.FilterDatasetAfterOpen(DataSet: TDataSet); From cf22b67ccf6979400ce285827ba36f5e2d839d6b Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 17 Jan 2018 12:02:57 -0200 Subject: [PATCH 156/294] Ticket_id: #64595 - Working folder do agendador trocado para C:\ProgramData --- Lib/UtilsUnit.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1748a2e..a82d487 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -112,7 +112,7 @@ function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; function GetTelaAprovacao(conn: TosSQLConnection) : string; function GetSpecialFolderPath(const folder : integer) : string; -function GetLocalAppDataFolder: string; +function GetProgramDataAppDataFolder: string; implementation @@ -1750,9 +1750,9 @@ function GetSpecialFolderPath(const folder : integer) : string; Result := ''; end; -function GetLocalAppDataFolder: string; +function GetProgramDataAppDataFolder: string; begin - Result := GetSpecialFolderPath(CSIDL_LOCAL_APPDATA); + Result := GetSpecialFolderPath(CSIDL_COMMON_APPDATA); //C:\ProgramData end; end. From 23ae581e2c61e281e3a5baca003cdaa3a13cfb12 Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 8 Jan 2018 09:58:31 -0200 Subject: [PATCH 157/294] =?UTF-8?q?Ticket=5Fid:=20#64595=20-=20Novas=20fun?= =?UTF-8?q?=C3=A7=C3=B5es=20para=20verifica=C3=A7=C3=A3o=20de=20pastas=20l?= =?UTF-8?q?ocais?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Conflicts: Lib/UtilsUnit.pas --- Lib/UtilsUnit.pas | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index af8072e..8748b92 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,7 +8,7 @@ interface Math, Wwdbgrid, RegExpr,StdCtrls, DB, DBClient, wwdbedit, Buttons, ShellAPI, acSysUtils, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Printers, Winapi.Messages, Winapi.Windows, System.SysUtils, Vcl.Graphics, - IdHashSHA, IdCoderMIME; + IdHashSHA, IdCoderMIME, SHFolder; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -153,6 +153,8 @@ function TryForceDirectories(const aDir: string; out aErrorMessage: string): boo function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; +function GetSpecialFolderPath(const folder : integer) : string; +function GetLocalAppDataFolder: string; implementation @@ -2380,5 +2382,22 @@ function GetFileSize(const filename: widestring): Int64; end; +function GetSpecialFolderPath(const folder : integer) : string; + const + SHGFP_TYPE_CURRENT = 0; + var + path: array [0..MAX_PATH] of char; + begin + if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then + Result := path + else + Result := ''; + end; + +function GetLocalAppDataFolder: string; +begin + Result := GetSpecialFolderPath(CSIDL_LOCAL_APPDATA); +end; + end. From d734a8a4d0dc84aa56529576e9330f04d062f441 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 17 Jan 2018 12:02:57 -0200 Subject: [PATCH 158/294] Ticket_id: #64595 - Working folder do agendador trocado para C:\ProgramData --- Lib/UtilsUnit.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8748b92..f6b474b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -154,7 +154,7 @@ function GetSHA1FromString(const text: string): string; function GetSHA1FromFile(const path: string): string; function GetFileSize(const filename: widestring): Int64; function GetSpecialFolderPath(const folder : integer) : string; -function GetLocalAppDataFolder: string; +function GetProgramDataAppDataFolder: string; implementation @@ -2394,9 +2394,9 @@ function GetSpecialFolderPath(const folder : integer) : string; Result := ''; end; -function GetLocalAppDataFolder: string; +function GetProgramDataAppDataFolder: string; begin - Result := GetSpecialFolderPath(CSIDL_LOCAL_APPDATA); + Result := GetSpecialFolderPath(CSIDL_COMMON_APPDATA); //C:\ProgramData end; end. From 2e312022142ead42409a84df925164a62b3d3a24 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 30 Jan 2018 14:25:15 -0200 Subject: [PATCH 159/294] Ticket_id: #64595 - retirados os warnings --- Lib/UtilsUnitGUI.pas | 2 -- 1 file changed, 2 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 26244a3..3406981 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -681,9 +681,7 @@ function SendMessageToTCPServer(const aMessage: string; aPort: integer): boolean procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); var - copyDataStruct : TCopyDataStruct; StringToSend: string; - handle: THandle; begin // loop every 10 ms while WaitForSingleObject(aProcessInformation.hProcess, 10) > 0 do From 11322eef86b3043e31f5b1f63d593ca436dcb657 Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 9 Mar 2018 16:34:11 -0300 Subject: [PATCH 160/294] =?UTF-8?q?Ticket=5Fid:=20#64483=20-=20nova=20fun?= =?UTF-8?q?=C3=A7=C3=A3o=20md5file?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 12eaa18..af1e83f 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -113,7 +113,7 @@ function GetFileSize(const filename: widestring): Int64; function GetTelaAprovacao(conn: TosSQLConnection) : string; function GetSpecialFolderPath(const folder : integer) : string; function GetProgramDataAppDataFolder: string; - +function MD5File(const FileName: string): string; implementation @@ -1618,6 +1618,21 @@ function GetMD5FromString(const text: string): String; end; end; +function MD5File(const FileName: string): string; +var + IdMD5: TIdHashMessageDigest5; + FS: TFileStream; +begin + IdMD5 := TIdHashMessageDigest5.Create; + FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Result := IdMD5.HashStreamAsHex(FS) + finally + FS.Free; + IdMD5.Free; + end; +end; + function GetDllName: string; var szFileName: array[0..MAX_PATH] of Char; From 261279ab84da42d945106073a1d44854f4d522bb Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 6 Apr 2018 09:36:31 -0300 Subject: [PATCH 161/294] =?UTF-8?q?Ticket=5Fid:=20#66062=20-=20fun=C3=A7?= =?UTF-8?q?=C3=A3o=20ApenasNumeros?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index af1e83f..b18b6a8 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -67,6 +67,7 @@ function getDescricaoSimNao(const vValor : Variant):String; function getDescricaoTipoResultado(const vValor : Variant):String; procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); function FormataStringList(texto, delimitador: string): string; +function ApenasNumeros(const valor : String) : String; function ApenasLetrasNumeros(nStr:String): String; function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; @@ -124,6 +125,15 @@ implementation const CSIDL_COMMON_APPDATA = $0023; +function ApenasNumeros(const valor : String) : String; +var + i : byte; +begin + Result := EmptyStr; + for i := 1 to length(valor) do + if valor[i] in ['0'..'9'] then + Result := result + valor[i]; +end; function ApenasLetrasNumeros(nStr:String): String; Var From 3b89c888aa283a72534d20f9b9e051bf798b403e Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 10 Apr 2018 16:17:56 -0300 Subject: [PATCH 162/294] Corrigido o erro "IOHandler value is not valid." --- Lib/UtilsUnit.pas | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index b18b6a8..2f81a39 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1758,16 +1758,20 @@ function GetPageAsString(const url: String): String; var lHTTP: TIdHTTP; lUri: TIdURI; + IOHandler: TIdSSLIOHandlerSocketOpenSSL; begin Result := EmptyStr; if TestConection(url) then begin lHTTP := TIdHTTP.Create(nil); + IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP); lUri := TIdUri.Create; try + lHTTP.IOHandler := IOHandler; Result := lHTTP.Get(lUri.URLEncode(url)); finally + FreeAndNil(IOHandler); FreeAndNil(lHTTP); FreeAndNil(lUri); end; From 069c9c1b129e3088e9fe12df9f22d35add5bb731 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 11 Apr 2018 08:34:08 -0300 Subject: [PATCH 163/294] Ticket_id: #66743 - Troca de TosSQLConnection para sqlConnection --- Lib/UtilsUnit.pas | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2f81a39..af3276e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,7 +8,7 @@ interface Classes, Math, RegExpr, DB, DBClient, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, - Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME; + Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME, Data.SqlExpr; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -51,9 +51,9 @@ function NomeDaTecla(Key: Word): string; function RoundToCurrency(const AValue: Currency; const ADigit: TRoundToRange = -2): Currency; function ConverteTecladoNumerico(Key: Word): Word; function ConverteMinutos(minutos: Integer): string; -function GetDateTime(conn: TosSQLConnection): TDateTime; -function GetNewID(conn: TosSQLConnection): Integer; -function GetGenerator(conn: TosSQLConnection; generator: string): Integer; +function GetDateTime(conn: TSQLConnection): TDateTime; +function GetNewID(conn: TSQLConnection): Integer; +function GetGenerator(conn: TSQLConnection; generator: string): Integer; function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; @@ -708,7 +708,7 @@ function ConverteMinutos(minutos: Integer): String; Result := Result+h+':'+m; end; -function GetDateTime(conn: TosSQLConnection): TDateTime; +function GetDateTime(conn: TSQLConnection): TDateTime; var qry: TosSQLQuery; begin @@ -724,7 +724,7 @@ function GetDateTime(conn: TosSQLConnection): TDateTime; end; end; -function GetNewID(conn: TosSQLConnection): Integer; +function GetNewID(conn: TSQLConnection): Integer; var qry: TosSQLQuery; begin @@ -740,7 +740,7 @@ function GetNewID(conn: TosSQLConnection): Integer; end; end; -function GetGenerator(conn: TosSQLConnection; generator: string): Integer; +function GetGenerator(conn: TSQLConnection; generator: string): Integer; var qry: TosSQLQuery; begin From 51e10a76bcee7a6ab19a333bb2621780d170ca8c Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 13 Apr 2018 11:08:38 -0300 Subject: [PATCH 164/294] TosSQLConnection trocado para TSQLConnection --- Lib/UtilsUnit.pas | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2f81a39..af3276e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,7 +8,7 @@ interface Classes, Math, RegExpr, DB, DBClient, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, - Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME; + Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME, Data.SqlExpr; type TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); @@ -51,9 +51,9 @@ function NomeDaTecla(Key: Word): string; function RoundToCurrency(const AValue: Currency; const ADigit: TRoundToRange = -2): Currency; function ConverteTecladoNumerico(Key: Word): Word; function ConverteMinutos(minutos: Integer): string; -function GetDateTime(conn: TosSQLConnection): TDateTime; -function GetNewID(conn: TosSQLConnection): Integer; -function GetGenerator(conn: TosSQLConnection; generator: string): Integer; +function GetDateTime(conn: TSQLConnection): TDateTime; +function GetNewID(conn: TSQLConnection): Integer; +function GetGenerator(conn: TSQLConnection; generator: string): Integer; function ConverteStrToDate(data: string): TDateTime; function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; @@ -708,7 +708,7 @@ function ConverteMinutos(minutos: Integer): String; Result := Result+h+':'+m; end; -function GetDateTime(conn: TosSQLConnection): TDateTime; +function GetDateTime(conn: TSQLConnection): TDateTime; var qry: TosSQLQuery; begin @@ -724,7 +724,7 @@ function GetDateTime(conn: TosSQLConnection): TDateTime; end; end; -function GetNewID(conn: TosSQLConnection): Integer; +function GetNewID(conn: TSQLConnection): Integer; var qry: TosSQLQuery; begin @@ -740,7 +740,7 @@ function GetNewID(conn: TosSQLConnection): Integer; end; end; -function GetGenerator(conn: TosSQLConnection; generator: string): Integer; +function GetGenerator(conn: TSQLConnection; generator: string): Integer; var qry: TosSQLQuery; begin From caafd5734a7f41bf1e76f378cce8eb8515acf54e Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 17 May 2018 16:44:45 -0300 Subject: [PATCH 165/294] Merge branch 'release_3.5.206' --- Forms/osCustomMainFrm.pas | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 2731e0c..5d98cf0 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -22,6 +22,7 @@ interface TDatamoduleClass = class of TDatamodule; TTipoExibicao = (teGrid, teRelat); + TOnEditForm = procedure (AForm: TosCustomEditForm) of object; TosCustomMainForm = class(TosForm) MainMenu: TMainMenu; @@ -226,6 +227,7 @@ TosCustomMainForm = class(TosForm) FSuperUserLogged: boolean; FIndiceMenu : Integer; FUltimoIndiceMenu : Integer; + FOnEditForm: TOnEditForm; procedure SetEditForm(const Value: TosCustomEditForm); procedure SetActionDblClick(const Value: TAction); function GetSelectedList: TStringList; @@ -238,6 +240,7 @@ TosCustomMainForm = class(TosForm) procedure checkOperations; procedure adjustReportZoom; + procedure SetOnEditForm(const Value: TOnEditForm); protected FCurrentTemplate: TMemoryStream; FCurrentResource: TosAppResource; @@ -272,6 +275,7 @@ TosCustomMainForm = class(TosForm) property EditForm: TosCustomEditForm read FEditForm write SetEditForm; property SelectedList: TStringList read GetSelectedList; property CurrentResource: TosAppResource read FCurrentResource; + property OnEditForm : TOnEditForm read FOnEditForm write SetOnEditForm; end; var @@ -373,6 +377,8 @@ procedure TosCustomMainForm.EditActionExecute(Sender: TObject); Form.VisibleButtons := [vbSalvarFechar, vbFechar]; if PrintAction.Enabled then Form.VisibleButtons := Form.VisibleButtons + [vbImprimir]; + if assigned(Self.FOnEditForm) then + Self.FOnEditForm(Form); Form.Edit('ID', iID); if Form.IsModified then begin @@ -793,6 +799,11 @@ procedure TosCustomMainForm.SetEditForm(const Value: TosCustomEditForm); end; +procedure TosCustomMainForm.SetOnEditForm(const Value: TOnEditForm); +begin + FOnEditForm := Value; +end; + function TosCustomMainForm.CreateCurrentEditForm: TosCustomEditForm; begin if (Assigned(FCurrentResource)) and @@ -1587,6 +1598,8 @@ procedure TosCustomMainForm.EditarTodosButtonClick(Sender: TObject); Form.VisibleButtons := [vbSalvarFechar, vbParar]; if PrintAction.Enabled then Form.VisibleButtons := Form.VisibleButtons + [vbImprimir]; + if assigned(Self.FOnEditForm) then + Self.FOnEditForm(Form); Form.Edit('ID', iID); if Form.IsModified then begin From 997ad0d5bc35b70eb7a83d8d9d3bff7f4790c08a Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 18 May 2018 16:28:45 -0300 Subject: [PATCH 166/294] =?UTF-8?q?Ticket=5FID=20#67596:=20bloquear=20oper?= =?UTF-8?q?a=C3=A7=C3=B5es=20no=20labmaster?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osFrm.pas | 79 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 78 insertions(+), 1 deletion(-) diff --git a/Forms/osFrm.pas b/Forms/osFrm.pas index fe28054..6f8c4c6 100644 --- a/Forms/osFrm.pas +++ b/Forms/osFrm.pas @@ -4,12 +4,15 @@ interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - ActnList, osUtils, ImgList, osActionList, System.Actions {$IFDEF VER320} , System.ImageList {$ENDIF}; + ActnList, osUtils, ImgList, osActionList, System.Generics.Collections, System.Actions {$IFDEF VER320} , System.ImageList {$ENDIF}; type TOperacao = (oInserir, oEditar, oExcluir, oVisualizar, oImprimir); TOperacoes = set of TOperacao; + TWhiteList = class(TObjectList) + end; + TosForm = class(TForm) ActionList: TosActionList; OnCheckActionsAction: TAction; @@ -20,8 +23,14 @@ TosForm = class(TForm) FOperacoes: TOperacoes; procedure SetOperacoes(const Value: TOperacoes); protected + FWhiteList: TWhiteList; + procedure DisableWinControlComponents(aWinControl: TWinControl); + procedure EnableWinControlComponents(aWinControl: TWinControl); + procedure AddControlsToWhiteListByContainer(aContainer: TWinControl); + function GetWhiteList: TWhiteList; public constructor Create(AOwner: TComponent); override; + destructor Destroy; override; published property Operacoes: TOperacoes read FOperacoes write SetOperacoes; end; @@ -31,6 +40,8 @@ TosForm = class(TForm) implementation +uses TypInfo, Vcl.ComCtrls, Vcl.Menus; + {$R *.DFM} { TBizForm } @@ -42,6 +53,11 @@ constructor TosForm.Create(AOwner: TComponent); //CheckDefaultParams; // Carrega os parâmetros empresa/estabelecimento se necessário end; +destructor TosForm.Destroy; +begin + FreeAndNil(FWhiteList); + inherited; +end; procedure TosForm.FormShow(Sender: TObject); begin @@ -59,4 +75,65 @@ procedure TosForm.FormCreate(Sender: TObject); Operacoes := [oInserir, oEditar, oExcluir, oVisualizar]; // operações Defaults end; +procedure TosForm.DisableWinControlComponents(aWinControl: TWinControl); +var + i: integer; + infoEnabled: PPropInfo; +begin + for i:= 0 to aWinControl.ComponentCount - 1 do + if (aWinControl.Components[i] is TPageControl) then + Self.DisableWinControlComponents(TPageControl(aWinControl.Components[i])) + else + begin + if (not self.GetWhiteList.Contains(aWinControl.Components[i])) and + ((aWinControl.Components[i] is TMenuItem) or (aWinControl.Components[i] is TWinControl)) then + begin + infoEnabled := TypInfo.GetPropInfo(aWinControl.Components[i], 'Enabled'); + if assigned(infoEnabled) then + TypInfo.SetPropValue(aWinControl.Components[i], 'Enabled', False); + end; + end; +end; + +procedure TosForm.EnableWinControlComponents(aWinControl: TWinControl); +var + i: integer; + infoEnabled: PPropInfo; +begin + for i:= 0 to aWinControl.ComponentCount - 1 do + begin + infoEnabled := TypInfo.GetPropInfo(aWinControl.Components[i], 'Enabled'); + if assigned(infoEnabled) then + TypInfo.SetPropValue(aWinControl.Components[i], 'Enabled', True); + if aWinControl.Components[i] is TWinControl then + EnableWinControlComponents(TWinControl(aWinControl.Components[i])); + end; +end; + +function TosForm.GetWhiteList: TWhiteList; +begin + if FWhiteList = nil then + begin + FWhiteList := TWhiteList.Create; + FWhiteList.OwnsObjects := False; + end; + Result := FWhiteList; +end; + +procedure TosForm.AddControlsToWhiteListByContainer(aContainer: TWinControl); +var + i: integer; + infoEnabled: PPropInfo; +begin + Self.GetWhiteList.Add(aContainer); + for i:= 0 to aContainer.ControlCount - 1 do + begin + Self.GetWhiteList.Add(aContainer.Controls[i]); + if aContainer.Controls[i] is TWinControl then + AddControlsToWhiteListByContainer(TWinControl(aContainer.Controls[i])); + end; +end; + + + end. From 49caf990e438d5382871f17960134d51bc5ff628 Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 21 May 2018 14:25:51 -0300 Subject: [PATCH 167/294] =?UTF-8?q?Ticket=5FID=20#67966:=20fun=C3=A7=C3=A3?= =?UTF-8?q?o=20logaritmo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osFuncoesParser.pas | 6 ++++++ Lib/osMaquina.pas | 1 + 2 files changed, 7 insertions(+) diff --git a/Lib/osFuncoesParser.pas b/Lib/osFuncoesParser.pas index 25db748..28e59ff 100644 --- a/Lib/osFuncoesParser.pas +++ b/Lib/osFuncoesParser.pas @@ -23,6 +23,7 @@ function trimstr(Parametros: TList): string; forward; function maiusculo(Parametros: TList): string; forward; function minusculo(Parametros: TList): string; forward; function inicial(Parametros: TList): string; forward; +function logaritmo(Parametros: TList): double; forward; implementation @@ -171,4 +172,9 @@ function inicial(Parametros: TList): string; Result := AnsiUpperCase(Copy(texto,1,1))+AnsiLowerCase(Copy(texto,2, Length(texto))); end; +function logaritmo(Parametros: TList): double; +begin + Result := Math.LogN(double(Parametros.Items[0]^), double(Parametros.Items[1]^)); +end; + end. diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index 684b641..a366c52 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -180,6 +180,7 @@ constructor TosMaquina.Create; FFuncoes.Add(TFuncaoMaquina.Create('MAIUSCULO', 1, maiusculo)); FFuncoes.Add(TFuncaoMaquina.Create('MINUSCULO', 1, minusculo)); FFuncoes.Add(TFuncaoMaquina.Create('INICIAL', 1, inicial)); + FFuncoes.Add(TFuncaoMaquina.Create('LOGN', 2, logaritmo)); end; destructor TosMaquina.Destroy; From f4c96799a9bea5f09088ae775b06355be552f83a Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 24 May 2018 14:16:46 -0300 Subject: [PATCH 168/294] delphi-php-serializer --- .gitmodules | 3 +++ Lib/delphi-php-serializer | 1 + 2 files changed, 4 insertions(+) create mode 100644 .gitmodules create mode 160000 Lib/delphi-php-serializer diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..cb16791 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "Lib/delphi-php-serializer"] + path = Lib/delphi-php-serializer + url = https://github.com/kingkellogg/delphi-php-serializer.git diff --git a/Lib/delphi-php-serializer b/Lib/delphi-php-serializer new file mode 160000 index 0000000..cf6a5db --- /dev/null +++ b/Lib/delphi-php-serializer @@ -0,0 +1 @@ +Subproject commit cf6a5db5f1c5664804327892bc16096157d55aa9 From 07756d4600b71937a276a29e63488fd4d63d1649 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 25 May 2018 16:14:43 -0300 Subject: [PATCH 169/294] removendo submodule --- Lib/delphi-php-serializer | 1 - 1 file changed, 1 deletion(-) delete mode 160000 Lib/delphi-php-serializer diff --git a/Lib/delphi-php-serializer b/Lib/delphi-php-serializer deleted file mode 160000 index cf6a5db..0000000 --- a/Lib/delphi-php-serializer +++ /dev/null @@ -1 +0,0 @@ -Subproject commit cf6a5db5f1c5664804327892bc16096157d55aa9 From 433ccf42fbe5eb22294627da7a5c03879fb1915d Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 25 May 2018 16:16:28 -0300 Subject: [PATCH 170/294] php serializer --- Lib/delphi-php-serializer/README.md | 38 +++++ .../Repositorio Original.txt | 1 + Lib/delphi-php-serializer/swPHPSerializer.pas | 133 ++++++++++++++++++ 3 files changed, 172 insertions(+) create mode 100644 Lib/delphi-php-serializer/README.md create mode 100644 Lib/delphi-php-serializer/Repositorio Original.txt create mode 100644 Lib/delphi-php-serializer/swPHPSerializer.pas diff --git a/Lib/delphi-php-serializer/README.md b/Lib/delphi-php-serializer/README.md new file mode 100644 index 0000000..d7df115 --- /dev/null +++ b/Lib/delphi-php-serializer/README.md @@ -0,0 +1,38 @@ +# delphi-php-serializer +Create serialized PHP structs with Delphi + +# What does this do? +It solves a problem I had some time ago. I wanted to build structs in Delphi/Object Pascal which could be deserialized on PHP side. It's nothing much, but maybe somebody out there has exactly this problem too, and saves a bit time. My pleasure. + +# Can you demonstrate? + +Sure. + + var + serializer : TPHPSerializer; + begin + serializer := TPHPSerializer.Create(); + serializer.Clear(); + + serializer.ArrayStart(Length(obj.configs)); + for sw := 0 to Length(obj.configs) - 1 do + begin + serializer.AddInt(sw); // array index! + serializer.CreateClass('EQUIP_LEVELUP_CONFIG_config_t', 3); + serializer.AddField('req_exp'); + serializer.AddInt(obj.configs[sw].req_exp); + serializer.AddField('addon_group'); + serializer.AddInt(obj.configs[sw].addon_group); + serializer.AddField('money_cost'); + serializer.AddInt(obj.configs[sw].money_cost); + serializer.CloseClass; + end; + serializer.CloseClass; // close array + +Result can then be retrieved by: + + serializer.GetFinalSWON(); + + You can then use this string with unserialize() PHP call, and like magic, have the object you described with delphi. + + Cheers. diff --git a/Lib/delphi-php-serializer/Repositorio Original.txt b/Lib/delphi-php-serializer/Repositorio Original.txt new file mode 100644 index 0000000..1643d50 --- /dev/null +++ b/Lib/delphi-php-serializer/Repositorio Original.txt @@ -0,0 +1 @@ +https://github.com/kingkellogg/delphi-php-serializar.git \ No newline at end of file diff --git a/Lib/delphi-php-serializer/swPHPSerializer.pas b/Lib/delphi-php-serializer/swPHPSerializer.pas new file mode 100644 index 0000000..884fbd1 --- /dev/null +++ b/Lib/delphi-php-serializer/swPHPSerializer.pas @@ -0,0 +1,133 @@ +unit swPHPSerializer; + +interface + +uses sysutils, math; + +type + TPHPSerializer = class + private const + _BRACKET_OPEN = '{'; + _BRACKET_CLOSE = '}'; + _DATA_DELIMITER = ';'; + + var + _result_string: string; + + public + constructor Create; + procedure Clear(dummy: boolean = true); + procedure CreateClass(class_name: string; num_class_members: integer); + procedure CloseClass; + procedure ArrayStart(array_len: integer); + procedure AddBoolean(b: boolean); + procedure AddInt(int: integer); + procedure AddFloat(f: double); + procedure AddString(str: string); + + procedure AddDepthLevel; + procedure CloseDepthLevel; + + Procedure AddField(field_name: string); + + procedure Add(b: boolean); overload; + procedure Add(int: integer); overload; + procedure Add(f: double); overload; + procedure Add(str: string); overload; + + function GetFinalSWON: string; + + end; + +implementation + +{ TswONBuilder } + +procedure TPHPSerializer.Add(int: integer); +begin + self.AddInt(int); +end; + +procedure TPHPSerializer.Add(b: boolean); +begin + self.AddBoolean(b); +end; + +procedure TPHPSerializer.Add(str: string); +begin + self.AddString(str); +end; + +procedure TPHPSerializer.Add(f: double); +begin + self.AddFloat(f); +end; + +procedure TPHPSerializer.AddBoolean(b: boolean); +begin + self._result_string := self._result_string + 'b:' + BoolToStr(b, false) + self._DATA_DELIMITER; +end; + +procedure TPHPSerializer.AddDepthLevel; +begin + +end; + +procedure TPHPSerializer.AddField(field_name: string); +begin + self._result_string := self._result_string + 's:' + inttostr(field_name.Length) + ':"' + field_name + '"' + self._DATA_DELIMITER; +end; + +procedure TPHPSerializer.AddFloat(f: double); +begin + self._result_string := self._result_string + 'd:' + floattostr(RoundTo(f, -4)) + self._DATA_DELIMITER; +end; + +procedure TPHPSerializer.AddInt(int: integer); +begin + self._result_string := self._result_string + 'i:' + inttostr(int) + self._DATA_DELIMITER; +end; + +procedure TPHPSerializer.AddString(str: string); +begin + self._result_string := self._result_string + 's:' + inttostr(str.Length) + ':"' + str + '"' + self._DATA_DELIMITER; +end; + +procedure TPHPSerializer.ArrayStart(array_len: integer); +begin + self._result_string := self._result_string + 'a:' + inttostr(array_len) + ':{'; +end; + +procedure TPHPSerializer.Clear(dummy: boolean = true); +begin + self._result_string := ''; +end; + +procedure TPHPSerializer.CloseClass; +begin + // force close remaining brackets + self._result_string := self._result_string + self._BRACKET_CLOSE; +end; + +procedure TPHPSerializer.CloseDepthLevel; +begin + +end; + +constructor TPHPSerializer.Create; +begin + self.Clear; +end; + +procedure TPHPSerializer.CreateClass(class_name: string; num_class_members: integer); +begin + self._result_string := self._result_string + 'O:' + inttostr(Length(class_name)) + ':"' + class_name + '":' + inttostr(num_class_members) + ':{'; +end; + +function TPHPSerializer.GetFinalSWON: string; +begin + + Result := self._result_string; +end; + +end. From 1f32e1b37cb90117854a0f0ddbdc9f192b486a06 Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 28 May 2018 09:49:55 -0300 Subject: [PATCH 171/294] =?UTF-8?q?Ticket=5FID=20#67896:=20fun=C3=A7=C3=A3?= =?UTF-8?q?o=20HandleException?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index af3276e..adef1d4 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -115,10 +115,11 @@ function GetTelaAprovacao(conn: TosSQLConnection) : string; function GetSpecialFolderPath(const folder : integer) : string; function GetProgramDataAppDataFolder: string; function MD5File(const FileName: string): string; +function HandleException(const aURL: string): string; implementation -uses DateUtils, Variants, StatusUnit, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, +uses DateUtils, Variants, StatusUnit, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, IdExceptionCore, IdStack, IdHash, IdHashMessageDigest, IdGlobal, IdURI; @@ -1795,5 +1796,28 @@ function GetProgramDataAppDataFolder: string; Result := GetSpecialFolderPath(CSIDL_COMMON_APPDATA); //C:\ProgramData end; +function HandleException(const aURL: string): string; +var + _Exception: Exception; +begin + _Exception := Exception(ExceptObject); + Result := _Exception.Message; + if _Exception is EIdIOHandlerPropInvalid then + Result := 'Protocolo inválido, tente alternar entre http:// e https://. URL: ' + aURL + else if _Exception is EIdConnectTimeout then + Result := 'Servidor indisponível (Connect time out):' + aURL + else if _Exception is EIdReadTimeOut then + Result := 'Servidor indisponível (Read time out):' + aURL + else if _Exception is EIdSocketError then + Result := 'Verifique se o servidor está respondendo ou se a URL/Porta está(ão) correta(s): ' + aURL + else if _Exception is EIdHTTPProtocolException then + begin + if EIdHTTPProtocolException(_Exception).ErrorCode = 500 then + Result := Format('Erro ao conectar-se ao servidor. Código de erro: %d. Erro interno no servidor. ',[EIdHTTPProtocolException(_Exception).ErrorCode]) + else + Result := Format('Erro ao conectar-se ao servidor. Código de erro: %d. Erro: %s.',[EIdHTTPProtocolException(_Exception).ErrorCode, EIdHTTPProtocolException(_Exception).ErrorMessage]); + end; +end; + end. From 00a3a0d2b9379a21a0398bca89955926f1a315ac Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 29 May 2018 17:16:10 -0300 Subject: [PATCH 172/294] Ticket_Id: #67867 - Chamada do form do central de compras pelo recurso --- Lib/UtilsUnit.pas | 135 +++++++++++++++++- Lib/delphi-php-serializer/swPHPSerializer.pas | 4 +- 2 files changed, 135 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index adef1d4..9dcbe79 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -8,9 +8,12 @@ interface Classes, Math, RegExpr, DB, DBClient, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, - Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME, Data.SqlExpr; + Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME, Data.SqlExpr, System.Generics.Collections, + Data.DBXJSON, IdHTTP, acNetUtils; type + TKeyValue = class(TDictionary); + TFormOrigem = (TabEditConvenio, TabEditLaudo, TabEditExame); THSHash = class @@ -116,10 +119,18 @@ function GetSpecialFolderPath(const folder : integer) : string; function GetProgramDataAppDataFolder: string; function MD5File(const FileName: string): string; function HandleException(const aURL: string): string; +procedure ParseJSONObject(aDict: TKeyValue; aJsonValue: TJSONValue; + aJsonString: TJSONString; aJsonPairEnum: TJSONPairEnumerator; + aJsonArrayEnum: TJSONArrayEnumerator); + +function GetIdHttp: TIdHTTP; +function getJsonStringFromServer(const aURL: string; var aException: string): string; +function MappJsonToDict(const aJsonString: string) : TJsonArray; + implementation -uses DateUtils, Variants, StatusUnit, IdHTTP, IdSSLOpenSSL, IdMultipartFormData, IdExceptionCore, IdStack, +uses DateUtils, Variants, StatusUnit, IdSSLOpenSSL, IdMultipartFormData, IdExceptionCore, IdStack, IdHash, IdHashMessageDigest, IdGlobal, IdURI; @@ -1819,5 +1830,125 @@ function HandleException(const aURL: string): string; end; end; +procedure ParseJSONObject(aDict: TKeyValue; aJsonValue: TJSONValue; + aJsonString: TJSONString; aJsonPairEnum: TJSONPairEnumerator; + aJsonArrayEnum: TJSONArrayEnumerator); +var + _jsonPairEnum: TJSONPairEnumerator; + _jsonArrayEnum: TJSONArrayEnumerator; + _jsonPair: TJSONPair; + _jsonString: TJSONString; + _jsonValue: TJSONValue; +begin + // ... IS A JSONObject? + if (aJsonValue is TJSONObject) then + begin + _jsonPairEnum := (aJsonValue as TJSONObject).GetEnumerator; + if (_jsonPairEnum.MoveNext) then + begin + _jsonPair := _jsonPairEnum.Current; + _jsonString := _jsonPair.JSONString; + _jsonValue := _jsonPair.JSONValue; + parseJSONObject(aDict, _jsonValue, _jsonString, _jsonPairEnum, + aJsonArrayEnum); + end; + end + // ... IS A JSON ARRAY? + else if (aJsonValue is TJsonArray) then + begin + _jsonArrayEnum := (aJsonValue as TJsonArray).GetEnumerator; + if (_jsonArrayEnum.MoveNext) then + begin + _jsonValue := _jsonArrayEnum.Current; + parseJSONObject(aDict, _jsonValue, nil, aJsonPairEnum, _jsonArrayEnum); + end; + end + // ... IS A JSON STRING? + else if (aJsonValue is TJSONString) then + begin + if (aJsonString <> nil) then + aDict.Add(aJsonString.Value, aJsonValue.Value); + end + // ... IS A JSONNull? + else if (aJsonValue is TJSONNull) then + begin + if (aJsonString <> nil) then + aDict.Add(aJsonString.Value, aJsonValue.Value); + end; + // ... to complete + // ... IS A JSONNumber? + // ... IS A JSONBool? + + // ... MOVE NEXT PROPERTY OF OBJECT + if (aJsonPairEnum <> nil) then + begin + if (aJsonPairEnum.MoveNext) then + begin + _jsonPair := aJsonPairEnum.Current; + _jsonString := _jsonPair.JSONString; + _jsonValue := _jsonPair.JSONValue; + // ... CALL RECURSIVE + parseJSONObject(aDict, _jsonValue, _jsonString, aJsonPairEnum, + aJsonArrayEnum); + end; + end; + // ... MOVE NEXT ITEM OF ARRAY + if (aJsonArrayEnum <> nil) then + begin + if (aJsonArrayEnum.MoveNext) then + begin + _jsonValue := aJsonArrayEnum.Current; + // ... CALL RECURSIVE + parseJSONObject(aDict, _jsonValue, _jsonString, aJsonPairEnum, aJsonArrayEnum); + end; + end; +end; + +function GetIdHttp: TIdHTTP; +begin + Result := acNetUtils.getHTTPInstance; + // verificar se o servidor está ativo. + Result.ConnectTimeout := 30000; + Result.ReadTimeout := 30000; + Result.Request.Clear; + Result.Request.Connection := 'keep-alive'; + Result.HandleRedirects := True; +end; + +function getJsonStringFromServer(const aURL: string; var aException: string): string; +var + _http: TIdHTTP; + _Response: TStringStream; +begin + aException := EmptyStr; + _Response := TStringStream.Create(EmptyStr, TEncoding.UTF8); + _http := GetIdHttp; + try + try + _http.Get(aURL, _Response); + if _http.ResponseCode = 204 then + Result := EmptyStr + else + Result := _Response.DataString; + + _http.Disconnect; + except + aException := UtilsUnit.HandleException(aURL); + end; + finally + FreeAndNil(_http); + FreeAndNil(_Response); + end; +end; + +function MappJsonToDict(const aJsonString: string) : TJsonArray; +begin + Result := nil; + if aJsonString <> EmptyStr then + begin + Result := TJSONObject.ParseJSONValue(TEncoding.ASCII.getBytes(aJsonString), 0) as TJsonArray; + end; +end; + end. diff --git a/Lib/delphi-php-serializer/swPHPSerializer.pas b/Lib/delphi-php-serializer/swPHPSerializer.pas index 884fbd1..9bfa0a0 100644 --- a/Lib/delphi-php-serializer/swPHPSerializer.pas +++ b/Lib/delphi-php-serializer/swPHPSerializer.pas @@ -21,7 +21,7 @@ TPHPSerializer = class procedure CloseClass; procedure ArrayStart(array_len: integer); procedure AddBoolean(b: boolean); - procedure AddInt(int: integer); + procedure AddInt(int: int64); procedure AddFloat(f: double); procedure AddString(str: string); @@ -83,7 +83,7 @@ procedure TPHPSerializer.AddFloat(f: double); self._result_string := self._result_string + 'd:' + floattostr(RoundTo(f, -4)) + self._DATA_DELIMITER; end; -procedure TPHPSerializer.AddInt(int: integer); +procedure TPHPSerializer.AddInt(int: int64); begin self._result_string := self._result_string + 'i:' + inttostr(int) + self._DATA_DELIMITER; end; From 28844cbeac1ccc625e5ee8f8cd1b435015365bb0 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 30 May 2018 16:55:58 -0300 Subject: [PATCH 173/294] Ticket_Id: #67869 - MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit bloquear os menus cancelar emissao do laudo excluir laudo desbloquear o botão Receber material --- Forms/osFrm.pas | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/Forms/osFrm.pas b/Forms/osFrm.pas index 6f8c4c6..31d4286 100644 --- a/Forms/osFrm.pas +++ b/Forms/osFrm.pas @@ -86,7 +86,7 @@ procedure TosForm.DisableWinControlComponents(aWinControl: TWinControl); else begin if (not self.GetWhiteList.Contains(aWinControl.Components[i])) and - ((aWinControl.Components[i] is TMenuItem) or (aWinControl.Components[i] is TWinControl)) then + ((aWinControl.Components[i] is TPopupMenu) or (aWinControl.Components[i] is TMenuItem) or (aWinControl.Components[i] is TWinControl)) then begin infoEnabled := TypInfo.GetPropInfo(aWinControl.Components[i], 'Enabled'); if assigned(infoEnabled) then @@ -123,14 +123,13 @@ function TosForm.GetWhiteList: TWhiteList; procedure TosForm.AddControlsToWhiteListByContainer(aContainer: TWinControl); var i: integer; - infoEnabled: PPropInfo; begin Self.GetWhiteList.Add(aContainer); - for i:= 0 to aContainer.ControlCount - 1 do + for i:= 0 to aContainer.ComponentCount - 1 do begin - Self.GetWhiteList.Add(aContainer.Controls[i]); - if aContainer.Controls[i] is TWinControl then - AddControlsToWhiteListByContainer(TWinControl(aContainer.Controls[i])); + Self.GetWhiteList.Add(aContainer.Components[i]); + if (aContainer.Components[i] is TWinControl) then + AddControlsToWhiteListByContainer(TWinControl(aContainer.Components[i])); end; end; From e303db8974b67f94e41fcabf0540295ce410f406 Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 6 Jun 2018 11:53:12 -0300 Subject: [PATCH 174/294] Ticket_ID: #68248 - Criando campos como integer no ClonarDadosClientDataSet --- Lib/UtilsUnit.pas | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index af3276e..e5411c1 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -949,6 +949,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien begin if (cdsOrigem.Fields[i]) is TMemoField then field := TMemoField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TIntegerField then + field := TIntegerField.Create(cdsDestino) else field := TStringField.Create(cdsDestino); @@ -972,8 +974,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien cdsDestino.Append; for i := 0 to cdsOrigem.FieldCount-1 do begin - cdsDestino.FieldByName(cdsDestino.Fields[i].FieldName).AsString := - cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).AsString; + if not cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).IsNull then + cdsDestino.FieldByName(cdsDestino.Fields[i].FieldName).AsString := cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).AsString; end; cdsDestino.Post; cdsOrigem.Next; From 4f585a3ea03881d4350782bfa9a0eb2db2639c62 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 15 Jun 2018 15:21:56 -0300 Subject: [PATCH 175/294] =?UTF-8?q?Ticket=5FID:=20#68419=20-=20Altera?= =?UTF-8?q?=C3=A7=C3=A3o=20do=20m=C3=A9todo=20de=20Rollback=20para=20evita?= =?UTF-8?q?r=20que=20sejam=20apresentadas=20exceptions=20na=20tela.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 877e172..56ecace 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -513,7 +513,7 @@ function TacCustomSQLMainData.InTransaction: boolean; procedure TacCustomSQLMainData.RollBack(var Transaction: TDBXTransaction); begin - SQLConnection.RollbackFreeAndNil(Transaction); + SQLConnection.RollbackIncompleteFreeAndNil(Transaction); end; function TacCustomSQLMainData.StartTransaction: TDBXTransaction; From 004826e1b2bb7c33b507fc789d82d6e5ff1b67af Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 22 Jun 2018 15:03:07 -0300 Subject: [PATCH 176/294] ticket_id: #68522 - impressao de laudo rascunho --- Forms/osCustomMainFrm.dfm | 111 ++++++++++++++++++------------------ Forms/osCustomMainFrm.pas | 56 ++++++++++++++---- Forms/osCustomMainFrm.vlb | 1 + Lib/osReportUtils.pas | 34 +++++++++++ Report/acCustomReportUn.dfm | 2 +- Report/acCustomReportUn.pas | 7 +++ 6 files changed, 144 insertions(+), 67 deletions(-) create mode 100644 Forms/osCustomMainFrm.vlb diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index 233ac8a..50ce57d 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -8,16 +8,15 @@ inherited osCustomMainForm: TosCustomMainForm Menu = MainMenu Visible = True WindowState = wsMaximized - ExplicitTop = -128 - ExplicitWidth = 1016 - ExplicitHeight = 699 + ExplicitWidth = 1024 + ExplicitHeight = 704 PixelsPerInch = 96 TextHeight = 13 object ControlBar: TControlBar [0] Left = 0 Top = 0 Width = 1008 - Height = 37 + Height = 39 Align = alTop AutoDrag = False DragKind = dkDock @@ -25,11 +24,10 @@ inherited osCustomMainForm: TosCustomMainForm object MainToolbar: TToolBar Left = 11 Top = 2 - Width = 262 - Height = 22 + Width = 268 AutoSize = True - ButtonHeight = 29 - ButtonWidth = 29 + ButtonHeight = 32 + ButtonWidth = 32 EdgeInner = esNone EdgeOuter = esNone Images = MainImageList @@ -42,59 +40,55 @@ inherited osCustomMainForm: TosCustomMainForm ShowHint = True end object EditToolButton: TToolButton - Left = 29 + Left = 32 Top = 0 Action = EditAction ParentShowHint = False ShowHint = True end object DeleteToolButton: TToolButton - Left = 58 + Left = 64 Top = 0 Action = DeleteAction ParentShowHint = False ShowHint = True end - object ToolButton11: TToolButton - Left = 87 - Top = 0 - Width = 8 - Caption = 'ToolButton11' - ImageIndex = 1 - Style = tbsSeparator - end object ViewToolButton: TToolButton - Left = 95 + Left = 96 Top = 0 Action = ViewAction ParentShowHint = False ShowHint = True end object PrintToolButton: TToolButton - Left = 124 + Left = 128 Top = 0 Action = PrintAction ParentShowHint = False ShowHint = True end - object ToolButton1: TToolButton - Left = 153 - Top = 0 - Width = 8 - Caption = 'ToolButton1' - ImageIndex = 5 - Style = tbsSeparator - end - object ToolButton4: TToolButton - Left = 161 + object PrintAllToolButton: TW7ToolButton + Left = 160 Top = 0 - Width = 8 - Caption = 'ToolButton4' - ImageIndex = 9 - Style = tbsSeparator + Width = 72 + Height = 32 + Hint = 'Imprimir Todos' + Version = '1.0.2.0' + Caption = 'Todos' + Images = MainImageList + ImageIndex = 4 + IconSize = is24px + Font.Charset = DEFAULT_CHARSET + Font.Color = 5978398 + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + Action = PrintAction + ParentFont = False + TabOrder = 0 end object PaginaInicialToolButton: TToolButton - Left = 169 + Left = 232 Top = 0 Caption = 'P'#225'gina Inicial' ImageIndex = 9 @@ -102,7 +96,7 @@ inherited osCustomMainForm: TosCustomMainForm end end object ConsultaPanel: TPanel - Left = 286 + Left = 292 Top = 2 Width = 656 Height = 48 @@ -197,29 +191,33 @@ inherited osCustomMainForm: TosCustomMainForm end object Panel2: TPanel [2] Left = 0 - Top = 37 + Top = 39 Width = 1008 - Height = 589 + Height = 587 Align = alClient BevelOuter = bvNone TabOrder = 2 + ExplicitTop = 41 + ExplicitHeight = 585 object Splitter1: TSplitter Left = 165 Top = 33 Width = 4 - Height = 556 + Height = 554 + ExplicitHeight = 556 end object WebBrowser: TWebBrowser Left = 169 Top = 33 Width = 839 - Height = 556 + Height = 554 Align = alClient TabOrder = 2 ExplicitLeft = 185 ExplicitWidth = 823 + ExplicitHeight = 556 ControlData = { - 4C000000B7560000773900000000000000000000000000000000000000000000 + 4C000000B7560000423900000000000000000000000000000000000000000000 000000004C000000000000000000000001000000E0D057007335CF11AE690800 2B2E12620A000000000000004C0000000114020000000000C000000000000046 8000000000000000000000000000000000000000000000000000000000000000 @@ -279,14 +277,15 @@ inherited osCustomMainForm: TosCustomMainForm Left = 0 Top = 33 Width = 165 - Height = 556 + Height = 554 Align = alLeft TabOrder = 3 + ExplicitHeight = 552 object TreeView1: TTreeView Left = 1 Top = 1 Width = 163 - Height = 533 + Height = 531 Align = alClient Color = clBtnFace HotTrack = True @@ -299,10 +298,11 @@ inherited osCustomMainForm: TosCustomMainForm TabOrder = 0 OnChange = TreeView1Change OnCustomDrawItem = TreeView1CustomDrawItem + ExplicitHeight = 529 end object EdtPesquisa: TEdit Left = 1 - Top = 534 + Top = 532 Width = 163 Height = 21 Align = alBottom @@ -311,6 +311,7 @@ inherited osCustomMainForm: TosCustomMainForm OnChange = EdtPesquisaChange OnEnter = EdtPesquisaEnter OnKeyDown = EdtPesquisaKeyDown + ExplicitTop = 530 end end end @@ -425,8 +426,8 @@ inherited osCustomMainForm: TosCustomMainForm OnClick = spbPreviewPrintClick end object spbPreviewWhole: TSpeedButton - Left = 38 - Top = 4 + Left = 39 + Top = 3 Width = 22 Height = 24 Hint = 'Whole Page' @@ -1007,7 +1008,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 4 Top = 96 Bitmap = { - 494C0101010003003C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010101000500040020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000800000002000000001002000000000000040 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000CECEBD00C6C6BD00C6BDB500C6BDB500C6BD @@ -1546,7 +1547,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 36 Top = 96 Bitmap = { - 494C0101010003003C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010101000500040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -1717,7 +1718,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 144 Top = 240 Bitmap = { - 494C0101020004003C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010102000500040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -1867,7 +1868,7 @@ inherited osCustomMainForm: TosCustomMainForm DataPipeline = ppDBPipeline PrinterSetup.BinName = 'Default' PrinterSetup.DocumentName = 'Report' - PrinterSetup.PaperName = 'A4' + PrinterSetup.PaperName = 'Custom' PrinterSetup.PrinterName = 'Default' PrinterSetup.SaveDeviceSettings = False PrinterSetup.mmMarginBottom = 6350 @@ -1876,7 +1877,7 @@ inherited osCustomMainForm: TosCustomMainForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 297000 PrinterSetup.mmPaperWidth = 210000 - PrinterSetup.PaperSize = 9 + PrinterSetup.PaperSize = 256 Template.Format = ftASCII Units = utMillimeters ArchiveFileName = '($MyDocuments)\ReportArchive.raf' @@ -2041,7 +2042,7 @@ inherited osCustomMainForm: TosCustomMainForm AutoStop = False PrinterSetup.BinName = 'Default' PrinterSetup.DocumentName = 'Report' - PrinterSetup.PaperName = 'Carta' + PrinterSetup.PaperName = 'Custom' PrinterSetup.PrinterName = 'Default' PrinterSetup.SaveDeviceSettings = False PrinterSetup.mmMarginBottom = 6350 @@ -2050,7 +2051,7 @@ inherited osCustomMainForm: TosCustomMainForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 279401 PrinterSetup.mmPaperWidth = 215900 - PrinterSetup.PaperSize = 1 + PrinterSetup.PaperSize = 256 Template.DatabaseSettings.DataPipeline = plItem Template.DatabaseSettings.NameField = 'Name' Template.DatabaseSettings.TemplateField = 'Template' @@ -2123,7 +2124,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 674 Top = 52 Bitmap = { - 494C01010B000C003C0016001600FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 + 494C01010B000D00040016001600FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000058000000420000000100200000000000C05A 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -2878,7 +2879,7 @@ inherited osCustomMainForm: TosCustomMainForm 00080003C0003F0080003C0000080003C0003F0080003C0000080003C0007F00 80003C0000080003C0007F0080007C0000080007C0007F008000FC000008000F C000FF008001FC000008001FE000FF008003FC000008003FF001FF008007FC00 - 0008007FF807FF00} + 0008007FF807FF0000000000000000000000000000000000000000000000} end object SQLConnection: TSQLConnection ConnectionName = 'IBLocal' diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 5d98cf0..800f453 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -16,7 +16,7 @@ interface ppModule, daDataModule, FMTBcd, osCustomDataSetProvider, osSQLDataSetProvider, daSQl, daQueryDataView, ppTypes, acCustomReportUn, osSQLQuery, acFilterController, CommCtrl, clipbrd, osCustomLoginFormUn, - acReportContainer, ppParameter, Data.DBXInterBase, System.Actions, Vcl.Samples.Spin; + acReportContainer, ppParameter, Data.DBXInterBase, System.Actions, Vcl.Samples.Spin, W7Classes, W7Buttons; type TDatamoduleClass = class of TDatamodule; @@ -47,7 +47,6 @@ TosCustomMainForm = class(TosForm) ViewAction: TAction; DeleteAction: TAction; PrintFilterAction: TAction; - ToolButton11: TToolButton; PopupMenu: TPopupMenu; Novo1: TMenuItem; Alterar1: TMenuItem; @@ -78,14 +77,12 @@ TosCustomMainForm = class(TosForm) Panel2: TPanel; Grid: TwwDBGrid; ResourcePanel: TPanel; - ToolButton1: TToolButton; AdvanceAction: TAction; RetrocedeAction: TAction; ActionDataSet: TosClientDataset; OnSelectResourceAction: TAction; ActionDataSetNOMECOMPONENTE: TStringField; WebBrowser: TWebBrowser; - ToolButton4: TToolButton; PaginaInicialToolButton: TToolButton; Exibir: TMenuItem; ExibirPaginaInicial: TMenuItem; @@ -144,6 +141,7 @@ TosCustomMainForm = class(TosForm) TreeView1: TTreeView; EdtPesquisa: TEdit; Splitter1: TSplitter; + PrintAllToolButton: TW7ToolButton; procedure EditActionExecute(Sender: TObject); procedure ViewActionExecute(Sender: TObject); procedure NewActionExecute(Sender: TObject); @@ -284,7 +282,7 @@ TosCustomMainForm = class(TosForm) implementation uses acCustomSQLMainDataUn, FilterDefEditFormUn, RecursoDataUn, - osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn; + osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn, UMensagemAguarde; {$R *.DFM} @@ -835,19 +833,55 @@ procedure TosCustomMainForm.CloseActionExecute(Sender: TObject); procedure TosCustomMainForm.PrintActionExecute(Sender: TObject); var Report : TacCustomReport; + FrmMensagem : TFrmMensagemAguarde; begin inherited; // Because the report is not often printed, the object can be created on the // fly - Report := CreateCurrentReport; - if Assigned (Report) then + if TAction(Sender).ActionComponent = PrintAllToolButton then + begin + FrmMensagem := TFrmMensagemAguarde.Create(Application); try - Report.Print (FIDField.AsInteger); + FrmMensagem.Show; + FilterDataset.First; + while not FilterDataset.Eof do + begin + FrmMensagem.setMensagem('Imprimindo... ' + IntToStr(FilterDataset.RecNo) + ' / ' + IntToStr(FilterDataset.RecordCount), True); + FrmMensagem.Update; + Report := CreateCurrentReport; + if Assigned (Report) then + try + Report.RecursoOrigem := CurrentResource.Name; + Report.forcePrintWithoutDialog := True; + Report.Print (FIDField.AsInteger); + finally + Report.Free; + end + else + begin + Assert(False, 'The report wasn''t created'); + break; + end; + + FilterDataset.Next; + end; finally - Report.Free; - end + FreeAndNil(FrmMensagem); + end; + end else - Assert(False, 'The report wasn''t created'); + begin + Report := CreateCurrentReport; + if Assigned (Report) then + try + Report.RecursoOrigem := CurrentResource.Name; + Report.Print (FIDField.AsInteger); + finally + Report.Free; + end + else + Assert(False, 'The report wasn''t created'); + end; end; function TosCustomMainForm.CreateCurrentReport: TacCustomReport; diff --git a/Forms/osCustomMainFrm.vlb b/Forms/osCustomMainFrm.vlb new file mode 100644 index 0000000..5f28270 --- /dev/null +++ b/Forms/osCustomMainFrm.vlb @@ -0,0 +1 @@ + \ No newline at end of file diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 87c996b..54726e9 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -32,6 +32,7 @@ type TIdade = class function getTemplateByName(name: string; stream: TMemoryStream): boolean; function getTemplateByID(id: integer; stream: TMemoryStream): boolean; function getTemplateIDByName(name: string): integer; + function getTemplateLaudoRascunho(name: string; stream: TMemoryStream): boolean; procedure replaceReportSQL(report: TppReport; template: TMemoryStream; strSQL: String); procedure replaceReportSQLAddParam(report: TppReport; template: TMemoryStream; @@ -91,6 +92,39 @@ function getTemplateByName(name: string; stream: TMemoryStream): boolean; end; end; + +function getTemplateLaudoRascunho(name: string; stream: TMemoryStream): boolean; +var + query: TosSQLQuery; + report: string; + ss: TStringStream; +begin + name := UpperCase(Name); + Result := false; + query := TosSQLQuery.Create(nil); + try + query.SQLConnection := acCustomSQLMainData.SQLConnectionMeta; + query.CommandText := ' SELECT ' + + ' I.template, '+ + ' I.ITEM_ID '+ + ' FROM ' + + ' RB_ITEM I '+ + ' join relatorio r on r.item_id = I.item_id '+ + ' join tipolaudo tp on tp.idrelatoriolaudo = r.idrelatorio '+ + ' WHERE tp.rascunho = ''S'' '; + query.open; + if query.fields[0].AsString <> '' then + begin + TBLOBField(query.fields[0]).SaveToStream(stream); + TacReportContainer(Application.MainForm.FindComponent('FReportDepot')). + addReport(query.fields[1].AsInteger, name, TBLOBField(query.fields[0]).AsString); + Result := true; + end; + finally + FreeAndNil(query); + end; +end; + function getTemplateIDByName(name: string): integer; var query: TosSQLDataset; diff --git a/Report/acCustomReportUn.dfm b/Report/acCustomReportUn.dfm index 0b232f3..bba264f 100644 --- a/Report/acCustomReportUn.dfm +++ b/Report/acCustomReportUn.dfm @@ -30,7 +30,7 @@ object acCustomReport: TacCustomReport PrinterSetup.mmMarginTop = 14552 PrinterSetup.mmPaperHeight = 297000 PrinterSetup.mmPaperWidth = 210000 - PrinterSetup.PaperSize = 9 + PrinterSetup.PaperSize = 256 Units = utMillimeters ArchiveFileName = '($MyDocuments)\ReportArchive.raf' DeviceType = 'Screen' diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index b6986f7..bf1e2b5 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -83,6 +83,7 @@ TacCustomReport = class(TDataModule) procedure ajustarAdendos; virtual; function replaceParamId(str: string; id: integer): string; virtual; public + RecursoOrigem: String; procedure replaceReportSQLAddWhere(report: TppReport; template: TMemoryStream; id:integer); property forcePrintWithoutDialog: Boolean read FForcePrintWithoutDialog @@ -163,6 +164,12 @@ procedure TacCustomReport.Print(const PID: integer); end; end; //chance da classe buscar seu template + if (not encontrou) and (self.RecursoOrigem = 'Aprovação Resultados') then + begin + encontrou := getTemplateLaudoRascunho(ClassName, stream); + if acCustomParametroSistemaData <> nil then + config.nomeImpressora := acCustomParametroSistemaData.getNomeImpressoraClasse('LASER'); + end; if not(encontrou) then begin encontrou := getTemplate(PID, stream, config); From 34ce1b7576fadfff741d013afb75ed7f5aa90312 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 27 Jun 2018 11:37:34 -0300 Subject: [PATCH 177/294] ticket_id: #68780 - lista de campos em uma tabela --- Lib/UtilsUnit.pas | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 386f09e..4b67c4d 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -126,6 +126,7 @@ procedure ParseJSONObject(aDict: TKeyValue; aJsonValue: TJSONValue; function GetIdHttp: TIdHTTP; function getJsonStringFromServer(const aURL: string; var aException: string): string; function MappJsonToDict(const aJsonString: string) : TJsonArray; +function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringList; implementation @@ -1952,5 +1953,28 @@ function MappJsonToDict(const aJsonString: string) : TJsonArray; end; end; +function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringList; +var + qry: TosSQLQuery; +begin + Result := TStringList.Create; + try + qry := TosSQLQuery.Create(nil); + qry.SQLConnection := conn; + qry.SQL.Text := 'select rdb$field_name AS CAMPOS from rdb$relation_fields rf where rf.rdb$relation_name = :nomeTabela '; + qry.ParamByName('nomeTabela').AsString := UPPERCASE(pTabela); + qry.Open; + qry.First; + while not qry.Eof do + begin + Result.Add(qry.FieldByName('CAMPOS').AsString); + qry.Next; + end; + finally + qry.Close; + FreeAndNil(qry); + end; +end; + end. From 29d201ecff0504f24974f0a831ca3da2c94ae0aa Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 3 Jul 2018 10:59:07 -0300 Subject: [PATCH 178/294] Ticket_Id: #65589 - Ajustes no HandleException --- Lib/UtilsUnit.pas | 4 +++- Lib/UtilsUnitGUI.pas | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 386f09e..3227ebc 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1815,7 +1815,9 @@ function HandleException(const aURL: string): string; begin _Exception := Exception(ExceptObject); Result := _Exception.Message; - if _Exception is EIdIOHandlerPropInvalid then + if _Exception is EIdOSSLCouldNotLoadSSLLibrary then + Result := 'DLLs libeay32.dll e ssleay32.dll não encontradas: ' + else if _Exception is EIdIOHandlerPropInvalid then Result := 'Protocolo inválido, tente alternar entre http:// e https://. URL: ' + aURL else if _Exception is EIdConnectTimeout then Result := 'Servidor indisponível (Connect time out):' + aURL diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 3406981..7d8102c 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -3,7 +3,7 @@ interface uses - Forms, Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, + Vcl.Forms, Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, wwdbedit, acSysUtils, Printers, osComboSearch, System.Classes, DB, DBClient, Winapi.PsApi, Winapi.Windows, Vcl.Graphics, ShellAPI, UMensagemAguarde, SysUtils, UtilsUnit, Variants, Winapi.Messages, Winapi.TlHelp32, Winsock; From 4bebac487fe47a101a7250d0f302f64420b1ab08 Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 6 Jul 2018 17:16:54 -0300 Subject: [PATCH 179/294] =?UTF-8?q?Ticket=5FId:=20#68843=20-=20=20Na=20bas?= =?UTF-8?q?e=20zerada=20de=20instala=C3=A7=C3=A3o,=20quando=20se=20tenta?= =?UTF-8?q?=20triar=20uma=20amostra=20de=20agrupamento=20pela=20primeira?= =?UTF-8?q?=20vez,=20aparece=20um=20erro=20de=20'Could=20not=20convert=20v?= =?UTF-8?q?ariant=20of=20type=20(Null)=20into=20type=20(OleStr)'.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.pas | 163 ++++++++++++-------------- 1 file changed, 76 insertions(+), 87 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 56ecace..5e6cc7d 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -6,7 +6,7 @@ interface SysUtils, Classes, Data.DBXFirebird, FMTBcd, SqlExpr, osSQLDataSet, DB, osSQLConnection, Provider, osCustomDataSetProvider, osSQLDataSetProvider, osClientDataSet, Contnrs, osSQLQuery, Forms, Types, Variants, - Data.DBXInterBase, Data.DBXCommon; + Data.DBXInterBase, Data.DBXCommon, System.Generics.Collections; const @@ -38,6 +38,9 @@ TRefreshTable = class(TObject) procedure RefreshData(NewVersion: integer); end; + TRefreshTableList = class(TList) + end; + TacCustomSQLMainData = class(TDataModule) prvFilter: TosSQLDataSetProvider; SQLConnection: TosSQLConnection; @@ -56,7 +59,7 @@ TacCustomSQLMainData = class(TDataModule) FIDUsuario: Integer; FNomeUsuario: String; FApelidoUsuario: String; - FRefreshTableList: TObjectList; + FRefreshTableList: TRefreshTableList; FProfile: string; function selectParamsFileName: string; @@ -130,38 +133,31 @@ procedure TacCustomSQLMainData.CheckVersion(PTableFilter: string); begin Query := GetQuery; try - with Query, Query.SQL do + Query.SQL.Text := + 'SELECT ' + + 'NomeTabela, ' + + 'Versao ' + + 'FROM ' + + 'VersaoTabela ' + PTableFilter; + Query.Open; + if not Query.Eof then begin - Text := - 'SELECT ' + - 'NomeTabela, ' + - 'Versao ' + - 'FROM ' + - 'VersaoTabela ' + PTableFilter; - Open; - if not Eof then + NomeTabelaField := TStringField(Query.Fields[0]); + VersaoField := TIntegerField(Query.Fields[1]); + while not Query.Eof do begin - NomeTabelaField := TStringField(Fields[0]); - VersaoField := TIntegerField(Fields[1]); - while not Eof do - begin + Application.ProcessMessages; - Application.ProcessMessages; - - RefreshTable := FindRefreshTable(Trim(NomeTabelaField.Value)); - if Assigned(RefreshTable) then - begin - with RefreshTable do - begin - if FVersion < VersaoField.Value then - RefreshData(VersaoField.Value); - end; - end; + RefreshTable := FindRefreshTable(Trim(NomeTabelaField.Value)); + if (RefreshTable <> nil) then + begin + if RefreshTable.FVersion < VersaoField.Value then + RefreshTable.RefreshData(VersaoField.Value); + end; - Next; - end; // while - end; // if - end; + Query.Next; + end; // while + end; // if finally FreeQuery(Query); end; @@ -179,8 +175,8 @@ constructor TacCustomSQLMainData.Create(AOwner: TComponent); begin FQueryList := TObjectList.Create(True); // OwnsObjects = True FIDHighValue := -1; - FRefreshTableList := TObjectList.Create(True); // OwnsObjects = True - inherited; + FRefreshTableList := TRefreshTableList.Create; // OwnsObjects = True + inherited Create(AOwner); end; {------------------------------------------------------------------------- @@ -193,11 +189,8 @@ constructor TacCustomSQLMainData.Create(AOwner: TComponent);  ------------------------------------------------------------------------} constructor TacCustomSQLMainData.Create(AOwner: TComponent; bd: string); begin - inherited Create(AOwner); + Self.Create(AOwner); self.BD := bd; - FQueryList := TObjectList.Create(True); // OwnsObjects = True - FIDHighValue := -1; - FRefreshTableList := TObjectList.Create(True); // OwnsObjects = True end; {------------------------------------------------------------------------- @@ -210,7 +203,11 @@ constructor TacCustomSQLMainData.Create(AOwner: TComponent; bd: string);  Atualização>  ------------------------------------------------------------------------} destructor TacCustomSQLMainData.Destroy; +var + _RefreshTable: TRefreshTable; begin + for _RefreshTable in Self.FRefreshTableList do + _RefreshTable.Free; FQueryList.Free; FRefreshTableList.Free; inherited; @@ -219,17 +216,15 @@ destructor TacCustomSQLMainData.Destroy; function TacCustomSQLMainData.FindRefreshTable( PTableName: string): TRefreshTable; var - i: integer; - n : integer; + _RefreshTable: TRefreshTable; begin - n := FRefreshTableList.Count - 1; - i := 0; - while (i <= n) and (TRefreshTable(FRefreshTableList.Items[i]).TableName <> PTableName) do - inc(i); - if i <= n then - Result := TRefreshTable(FRefreshTableList.Items[i]) - else - Result := nil; + Result := nil; + for _RefreshTable in Self.FRefreshTableList do + if _RefreshTable.TableName.Trim = PTableName.Trim then + begin + Result := _RefreshTable; + break; + end; end; {------------------------------------------------------------------------- @@ -267,36 +262,30 @@ procedure TacCustomSQLMainData.LoadRefreshTables; begin Query := GetQuery; try - with Query, Query.SQL do - begin - Text := + Query.SQL.Text := 'SELECT ' + 'NomeTabela, ' + 'Versao ' + 'FROM ' + 'VersaoTabela '; - Open; - if not Eof then + Query.Open; + if not Query.Eof then begin - NomeTabelaField := TStringField(Fields[0]); - VersaoField := TIntegerField(Fields[1]); + NomeTabelaField := TStringField(Query.Fields[0]); + VersaoField := TIntegerField(Query.Fields[1]); FRefreshTableList.Clear; - while not Eof do + while not Query.Eof do begin RefreshTable := TRefreshTable.Create; - with RefreshTable do - begin - FTableName := Trim(NomeTabelaField.Value); - FVersion := VersaoField.Value; - FDataSet := nil; - end; + RefreshTable.FTableName := Trim(NomeTabelaField.Value); + RefreshTable.FVersion := VersaoField.Value; + RefreshTable.FDataSet := nil; FRefreshTableList.Add(RefreshTable); - Next; + Query.Next; end; // while end; // if - end; finally FreeQuery(Query); end; @@ -465,13 +454,10 @@ function TacCustomSQLMainData.GetServerDatetime(aConnection: TSQLConnection=nil) Query.SQLConnection := aConnection; try - with Query, Query.SQL do - begin - Add('select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'); - Open; - Result := Fields[0].AsDatetime; - Close; - end; + Query.SQL.Add('select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'); + Query.Open; + Result := Query.Fields[0].AsDatetime; + Query.Close; finally FreeQuery(Query); end; @@ -483,9 +469,7 @@ procedure TacCustomSQLMainData.GetUserInfo(apelido: string); begin Query := GetQuery; try - with Query, Query.SQL do - begin - Text := + Query.SQL.Text := 'SELECT ' + 'Nome, ' + 'IdUsuario, ' + @@ -494,13 +478,12 @@ procedure TacCustomSQLMainData.GetUserInfo(apelido: string); 'Usuario ' + 'WHERE ' + 'upper(Apelido) = upper(:Apelido)'; - ParamByName('Apelido').AsString := apelido; - Open; - FNomeUsuario := Fields[0].AsString; - FIDUsuario := Fields[1].AsInteger; - FApelidoUsuario := Fields[2].AsString; - Close; - end; + Query.ParamByName('Apelido').AsString := apelido; + Query.Open; + FNomeUsuario := Query.FieldbyName('Nome').AsString; + FIDUsuario := Query.FieldByName('IdUsuario').AsInteger; + FApelidoUsuario := Query.FieldByName('Apelido').AsString; + Query.Close; finally FreeQuery(Query); end; @@ -544,7 +527,15 @@ procedure TacCustomSQLMainData.RegisterRefreshTable(PTableName: string; RefreshTable: TRefreshTable; begin RefreshTable := FindRefreshTable(PTableName); - if Assigned(RefreshTable) then + if (RefreshTable = nil) then + begin + RefreshTable := TRefreshTable.Create; + RefreshTable.FTableName := PTableName; + RefreshTable.FVersion := 0; + RefreshTable.FDataSet := PDataSet; + Self.FRefreshTableList.Add(RefreshTable) + end + else RefreshTable.FDataset := PDataSet; PDataSet.Open; @@ -582,7 +573,6 @@ procedure TacCustomSQLMainData.UpdateVersion(PTableName: string); finally FreeQuery(Query); end; - CheckVersion('WHERE NomeTabela = ' + QuotedStr(PTableName)); end; @@ -636,12 +626,11 @@ function TacCustomSQLMainData.GeTosSQLDataset: TosSQLDataset; procedure TRefreshTable.RefreshData(NewVersion: integer); begin FVersion := NewVersion; - if Assigned(FDataSet) then - with FDataSet do - begin - Close; - Open; - end; + if (FDataSet <> nil) then + begin + FDataSet.Close; + FDataSet.Open; + end; end; function TacCustomSQLMainData.getSQLResult(sqlText: string; From 7c98b624002a67a47416b30652bc0938bbc37de3 Mon Sep 17 00:00:00 2001 From: Danilo Date: Thu, 26 Jul 2018 15:53:55 -0300 Subject: [PATCH 180/294] =?UTF-8?q?Ticket=5FId:=20#69259=20-=20Novo=20m?= =?UTF-8?q?=C3=A9todo=20SaveToFile?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index f7d7e71..d52c298 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -23,7 +23,8 @@ THSHash = class const sMODELOMSGLOG = #13+#13+'Campo %s alterado.'+#13+'De: %s'+#13+'Para: %s'; - + szChar = SizeOf(Char); + function isDigitOrControl(Key: char): boolean; function RemoveAcento(Str:String): String; procedure criarArquivoBackupIB(nomeArq: string); @@ -127,6 +128,7 @@ function GetIdHttp: TIdHTTP; function getJsonStringFromServer(const aURL: string; var aException: string): string; function MappJsonToDict(const aJsonString: string) : TJsonArray; function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringList; +procedure SaveToFile(const aFilename, aContent: string); implementation @@ -1978,5 +1980,24 @@ function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringLis end; end; +procedure SaveToFile(const aFilename, aContent: string); +var + FileStream: TFileStream; + _FH: NativeUInt; +begin + if not FileExists(aFilename) then + _FH := fmCreate + else + _FH := fmOpenReadWrite; + + FileStream := TFileStream.Create(aFileName, _FH, fmShareDenyNone); + try + FileStream.Seek(0, soFromEnd); + FileStream.WriteBuffer(Pointer(aContent)^, (Length(aContent) * szChar)); + finally + FileStream.Free; + end; +end; + end. From ebdc6e7ba7b1e8e4997e8c94956a31df9fb76aa7 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 8 Aug 2018 14:14:22 -0300 Subject: [PATCH 181/294] =?UTF-8?q?Ticket=5FId:=20#68847=20-=20M=C3=A9todo?= =?UTF-8?q?=20ConvertTextoToRTF=20aceita=20fontSize=20e=20FontName?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnitGUI.pas | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 7d8102c..b10f860 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -3,7 +3,7 @@ interface uses - Vcl.Forms, Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, + Vcl.Forms, Vcl.Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, wwdbedit, acSysUtils, Printers, osComboSearch, System.Classes, DB, DBClient, Winapi.PsApi, Winapi.Windows, Vcl.Graphics, ShellAPI, UMensagemAguarde, SysUtils, UtilsUnit, Variants, Winapi.Messages, Winapi.TlHelp32, Winsock; @@ -31,7 +31,7 @@ procedure habilitaComponentes(comps: varArrayOfcomps); procedure desHabilitaComponentes(comps: array of TComponent); procedure ImprimirImpressoraTermica(const comando, impressora: String); function ConverteRTF(rtf: string): string; -function ConverteTextoToRTF(Texto: string): string; +function ConverteTextoToRTF(const Texto: string; FontSize: integer = 0; FontName: string= ''): string; function getCampoSemRTF(const vValor : Variant):String; function CriarMsgLogAlteracaoField(aField : TField):String; overload; function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; @@ -271,7 +271,7 @@ function ConverteRTF(rtf: string): string; end; end; -function ConverteTextoToRTF(Texto: string): string; +function ConverteTextoToRTF(const Texto: string; FontSize: integer = 0; FontName: string= ''): string; var form: TForm; richEdit: TRichEdit; @@ -284,6 +284,10 @@ function ConverteTextoToRTF(Texto: string): string; form := TForm.Create(nil); richEdit := TRichEdit.Create(form); richEdit.Parent := form; + if FontSize > 0 then + richEdit.Font.Size := FontSize; + if not FontName.IsEmpty then + richEdit.Font.Name := FontName; richEdit.Text:= Texto; richEdit.PlainText := False; richEdit.Lines.SaveToStream(ss); From 8bacd32e9572ddce82acfb1e335b4274d23e043a Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 8 Aug 2018 16:38:31 -0300 Subject: [PATCH 182/294] ticket_id: #69642 - Converte Texto to RTF --- Lib/UtilsUnitGUI.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index b10f860..8ba102b 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -277,7 +277,9 @@ function ConverteTextoToRTF(const Texto: string; FontSize: integer = 0; FontName richEdit: TRichEdit; ss: TStringStream; begin - if not isRTFValue(Texto) then + if isRTFValue(Texto) then + Result := Texto + else begin try ss := TStringStream.Create(Texto); From 458144812d9bb26f81a31a98e6dbf70367afce27 Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 13 Aug 2018 09:44:46 -0300 Subject: [PATCH 183/294] Ticket_Id: #69584 - Tratamento quando nao tem application.mainform --- Lib/osErrorHandler.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Lib/osErrorHandler.pas b/Lib/osErrorHandler.pas index 443342c..7dfc9c5 100644 --- a/Lib/osErrorHandler.pas +++ b/Lib/osErrorHandler.pas @@ -364,8 +364,11 @@ procedure TosErrorHandlerForm.WarningEmpty(PField: TField; PFieldName: string); procedure TosErrorHandlerForm.FormShow(Sender: TObject); begin - Self.Left := Application.MainForm.ClientOrigin.X + Application.MainForm.ClientWidth - Self.Width - 18; - Self.Top := Application.MainForm.ClientOrigin.Y + 54; + if Application.MainForm <> nil then + begin + Self.Left := Application.MainForm.ClientOrigin.X + Application.MainForm.ClientWidth - Self.Width - 18; + Self.Top := Application.MainForm.ClientOrigin.Y + 54; + end; end; From efac05f8e7e4e6a039b7710073fe64c640ff5933 Mon Sep 17 00:00:00 2001 From: Danilo Date: Tue, 14 Aug 2018 09:10:57 -0300 Subject: [PATCH 184/294] Ticket_Id: #69392 - Tratamento de IOHandler para HTTPS --- Lib/UtilsUnit.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d52c298..abbcf99 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1926,10 +1926,16 @@ function getJsonStringFromServer(const aURL: string; var aException: string): st var _http: TIdHTTP; _Response: TStringStream; + IOHandler: TIdSSLIOHandlerSocketOpenSSL; begin aException := EmptyStr; _Response := TStringStream.Create(EmptyStr, TEncoding.UTF8); _http := GetIdHttp; + if aURL.ToLower.Contains('https') then + begin + IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(_http); + _http.IOHandler := IOHandler; + end; try try _http.Get(aURL, _Response); @@ -1943,6 +1949,8 @@ function getJsonStringFromServer(const aURL: string; var aException: string): st aException := UtilsUnit.HandleException(aURL); end; finally + if aURL.ToLower.Contains('https') then + FreeAndNil(IOHandler); FreeAndNil(_http); FreeAndNil(_Response); end; From 85cdb29f91669282c89806ba1dcbc192a5184db3 Mon Sep 17 00:00:00 2001 From: Danilo Date: Wed, 29 Aug 2018 17:53:01 -0300 Subject: [PATCH 185/294] =?UTF-8?q?Ticket=5FId:=20#70173=20-=20Tratamento?= =?UTF-8?q?=20para=20ler=20sa=C3=ADda=20de=20erro=20da=20impress=C3=A3o?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 18 ++++++++++++++++++ Lib/UtilsUnitGUI.pas | 24 +++++++++++++++++------- 2 files changed, 35 insertions(+), 7 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d52c298..daf9186 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -129,6 +129,7 @@ function getJsonStringFromServer(const aURL: string; var aException: string): st function MappJsonToDict(const aJsonString: string) : TJsonArray; function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringList; procedure SaveToFile(const aFilename, aContent: string); +function LoadFromFile(const aFileName: string): string; implementation @@ -1999,5 +2000,22 @@ procedure SaveToFile(const aFilename, aContent: string); end; end; +function LoadFromFile(const aFileName: string): string; +var + _SStream: TStringStream; +begin + Result := EmptyStr; + if FileExists(aFileName) then + begin + _SStream := TStringStream.Create(aFileName, TEncoding.ANSI); + try + _SStream.LoadFromFile(aFileName); + Result := _SStream.DataString; + finally + _SStream.Free; + end; + end; +end; + end. diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 7d8102c..1fe4e83 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -6,7 +6,7 @@ interface Vcl.Forms, Controls, ComCtrls, DBCtrls, wwdbdatetimepicker, Wwdbcomb, StdCtrls, Buttons, Wwdbgrid, wwdbedit, acSysUtils, Printers, osComboSearch, System.Classes, DB, DBClient, Winapi.PsApi, Winapi.Windows, Vcl.Graphics, ShellAPI, UMensagemAguarde, SysUtils, UtilsUnit, Variants, Winapi.Messages, Winapi.TlHelp32, - Winsock; + Winsock, StrUtils; type varArrayOfcomps = array of TComponent; @@ -29,7 +29,7 @@ procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); procedure setHabilitaComponente(comp: TComponent; enabled: boolean); procedure habilitaComponentes(comps: varArrayOfcomps); procedure desHabilitaComponentes(comps: array of TComponent); -procedure ImprimirImpressoraTermica(const comando, impressora: String); +procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: string); function ConverteRTF(rtf: string): string; function ConverteTextoToRTF(Texto: string): string; function getCampoSemRTF(const vValor : Variant):String; @@ -44,7 +44,7 @@ function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; Alter const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; function isRTFValue(vValor: Variant): Boolean; //{\rtf procedure TrimAppMemorySize; -procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); +function dgCreateProcess(const FileName: string; SleepInterval: integer = 10000): boolean; function GetPrinters: string; function GetProcessList: string; function GetSystemInfo: string; @@ -221,10 +221,11 @@ procedure setHabilitaEdit(edit: TEdit; enabled: boolean); end; end; -procedure ImprimirImpressoraTermica(const comando, impressora: String); +procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: string); var FBat, FComando: TextFile; diretorio: string; + _erroType, _erroPrint: string; begin diretorio:= GetSpecialFolderLocation(Application.Handle, CSIDL_COMMON_APPDATA) + '\'; @@ -239,15 +240,24 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String); CloseFile(FComando); end; + _erroType := diretorio + '\errotype.txt'; + _erroPrint := diretorio + '\erroprint.txt'; + AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); try Rewrite(FBat); - Writeln(FBat, 'TYPE "' + diretorio + 'COMANDO.TXT" > "'+impressora+'"'); + Writeln(FBat, Format('(TYPE "%s\COMANDO.TXT" >"%s" 2>%s ) 2>%s',[diretorio, impressora, _erroType, _erroPrint])); finally CloseFile(FBat); end; + SysUtils.DeleteFile(_erroType); + SysUtils.DeleteFile(_erroPrint); + ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); + + erro := UtilsUnit.LoadFromFile(_erroType); + erro := erro + StrUtils.IfThen(erro.IsEmpty, #13#10) + UtilsUnit.LoadFromFile(_erroPrint); end; function ConverteRTF(rtf: string): string; @@ -484,7 +494,7 @@ procedure TrimAppMemorySize; Application.ProcessMessages; end; -procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000); +function dgCreateProcess(const FileName: string; SleepInterval: integer = 10000): boolean; var ProcInfo: TProcessInformation; StartInfo: TStartupInfo; FrmMensagem : TFrmMensagemAguarde; @@ -505,7 +515,7 @@ procedure dgCreateProcess(const FileName: string; SleepInterval: integer = 10000 StartInfo.dwX := 0; StartInfo.dwY := 0; - CreateProcess( + Result := CreateProcess( nil, PChar(FileName), nil, Nil, False, From 408c74954f806348e53b49b5ae769e93c55a4814 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 14 Sep 2018 15:05:11 -0300 Subject: [PATCH 186/294] evitando erro no getDescricaoSimNao --- Lib/UtilsUnit.pas | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 95d4880..d5c2df5 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -929,12 +929,16 @@ function getDescricaoSimNao(const vValor : Variant):String; var cValor : Char; begin - cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); - case cValor of - 'S' : Result := 'Sim'; - 'N' : Result := 'Não'; - else - result := ''; + try + cValor := Char(AnsiString(VarToStrDef(vValor, ' '))[1]); + case cValor of + 'S' : Result := 'Sim'; + 'N' : Result := 'Não'; + else + result := ''; + end; + except + result := 'Indefinido' end; end; From 55da811ba8e66c175aba70c41c7376f78146560b Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 20 Sep 2018 17:38:12 -0300 Subject: [PATCH 187/294] Ao abrir uma requisicao e dado o Open no FmasterDataSet ele estava vazio, fazendo o close antes do open o problema foi resolvido. --- Forms/osCustomEditFrm.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 6bf4b5e..f79a4d1 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -123,6 +123,7 @@ function TosCustomEditForm.Edit(const KeyFields: string; const KeyValues: Varian CheckMasterDataset; ParseParams(FMasterDataset.Params, KeyFields, KeyValues); + FMasterDataset.close; FMasterDataset.Open; OnCheckActionsAction.Execute; From 00be60e124d143730b6c3e5ca4ad878c6b7bb305 Mon Sep 17 00:00:00 2001 From: Danilo Date: Fri, 21 Sep 2018 08:14:07 -0300 Subject: [PATCH 188/294] =?UTF-8?q?Ticket=5FId:=20#70173=20-=20nova=20fun?= =?UTF-8?q?=C3=A7=C3=A3o=20textfrombase64?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 95d4880..6038c33 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -78,6 +78,7 @@ function EspacoDireita(Valor: String; const Tamanho: Integer): String; function KeyToStr(Key:Word): String; function Base64FromBinary(const FileName: String): string; function Base64FromText(const text: String): string; +function TextFromBase64(const text: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; function Base64FromStream(const input: TStream): string; @@ -1058,7 +1059,12 @@ function Base64FromBinary(const FileName: String): string; function Base64FromText(const text: String): string; begin - Result := EncodeString(text); + Result := Soap.EncdDecd.EncodeString(text); +end; + +function TextFromBase64(const text: String): string; +begin + Result := Soap.EncdDecd.DecodeString(text); end; function Base64FromStream(const input: TStream): string; From 982592e12e0fec5ac400bb8b971c98ae8f56f17c Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 26 Sep 2018 11:47:20 -0300 Subject: [PATCH 189/294] =?UTF-8?q?ticket=5Fid:=20#70861=20-=20Erro=20ao?= =?UTF-8?q?=20salvar=20log=20de=20altera=C3=A7=C3=A3o=20do=20dataset=20qua?= =?UTF-8?q?ndo=20o=20campo=20=C3=A9=20um=20lookup?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnitGUI.pas | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 78adb3a..5080345 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -330,16 +330,15 @@ function getCampoSemRTF(const vValor : Variant):String; function CriarMsgLogAlteracaoField(aField : TField):String; overload; begin Result := EmptyStr; - if FieldHasChanged(aField) then + if (aField.FieldKind <> fkLookup) and (FieldHasChanged(aField)) then Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), getCampoSemRTF(aField.NewValue)]); - end; function CriarMsgLogAlteracaoField(aField : TField; aFuncaoGetDescricao : TFuncaoParametroGetDesc):String; overload; begin Result := EmptyStr; - if FieldHasChanged(aField) then + if (aField.FieldKind <> fkLookup) and (FieldHasChanged(aField)) then Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, aFuncaoGetDescricao(aField.OldValue), aFuncaoGetDescricao(aField.NewValue)]); end; From c9d5dc6dd04e7900100919f6c4cd6cc58e0bebf5 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 27 Sep 2018 14:28:34 -0300 Subject: [PATCH 190/294] ticket_id: #70879 - Close e Open do dataset ao tentar excluir um registro de um recurso --- Forms/osCustomEditFrm.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index f79a4d1..2b26118 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -172,6 +172,7 @@ function TosCustomEditForm.View(const KeyFields: string; const KeyValues: Varian FMasterDataset.ReadOnly := True; ParseParams(FMasterDataset.Params, KeyFields, KeyValues); + FMasterDataset.Close; FMasterDataset.Open; OnCheckActionsAction.Execute; From 58c05aa560ddf483a88f9d261c29c255cfa0947d Mon Sep 17 00:00:00 2001 From: Danilo Date: Mon, 1 Oct 2018 11:44:34 -0300 Subject: [PATCH 191/294] Ticket_Id: #70934 - Ajuste warning, usando DBXPLatform mas nao estava presente no uses explicitamente --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 6479bde..a405aef 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -9,7 +9,7 @@ interface osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, Vcl.Graphics, Winapi.Messages, SHFolder, IdCoderMIME, Data.SqlExpr, System.Generics.Collections, - Data.DBXJSON, IdHTTP, acNetUtils; + Data.DBXJSON, IdHTTP, acNetUtils, Data.DBXPlatform; type TKeyValue = class(TDictionary); From 112a14ac7586d2cb64b187b6b386a341dee27d87 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 14 Nov 2018 16:36:53 -0200 Subject: [PATCH 192/294] ticket_id: #71555 - Configuracao de proxy no LM, novos campos e configuracao no componente http --- Lib/UtilsUnit.pas | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a405aef..79fd51b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -82,7 +82,7 @@ function TextFromBase64(const text: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; function Base64FromStream(const input: TStream): string; -function TestConection(const url: String): boolean; +function TestConnection(const url: String): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil): Boolean; @@ -136,7 +136,7 @@ function LoadFromFile(const aFileName: string): string; implementation uses DateUtils, Variants, StatusUnit, IdSSLOpenSSL, IdMultipartFormData, IdExceptionCore, IdStack, - IdHash, IdHashMessageDigest, IdGlobal, IdURI; + IdHash, IdHashMessageDigest, IdGlobal, IdURI, ParametroSistemaDataUn; const @@ -1171,11 +1171,12 @@ function Base64ToBitmap(base64Field: TBlobField): TBitmap; end; end; -function TestConection(const url: String): boolean; +function TestConnection(const url: String): boolean; var HTTPClient: TidHTTP; Stream: TStringStream; LHandler: TIdSSLIOHandlerSocketOpenSSL; + ParametroSistema: TParametroSistemaData; begin Stream := TStringStream.Create('', TEncoding.UTF8); @@ -1188,6 +1189,17 @@ function TestConection(const url: String): boolean; HTTPClient.ReadTimeout := 30000; HTTPClient.ConnectTimeout := 30000; + ParametroSistema := TParametroSistemaData.Create(self); + ParametroSistema.MasterDataSet.Open; + if ParametroSistema.MasterDataSetENDERECOPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetENDERECOPROXY.AsString; + if ParametroSistema.MasterDataSetPORTAPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetPORTAPROXY.AsString; + if ParametroSistema.MasterDataSetUSUARIOPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetUSUARIOPROXY.AsString; + if ParametroSistema.MasterDataSetSENHAPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetSENHAPROXY.AsString; + try try HTTPClient.Get(url, Stream); @@ -1201,6 +1213,7 @@ function TestConection(const url: String): boolean; Stream.Free; LHandler.Free; HTTPClient.Free; + FreeAndNil(ParametroSistema); end; end; @@ -1279,7 +1292,7 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon begin _FHttp := TIdHTTP.Create(AOwner); try - Result := TestConection(address); + Result := TestConnection(address); try if stream is TIdMultiPartFormDataStream then _FHttp.Post(address, TIdMultiPartFormDataStream(stream)) @@ -1790,7 +1803,7 @@ function GetPageAsString(const url: String): String; begin Result := EmptyStr; - if TestConection(url) then + if TestConnection(url) then begin lHTTP := TIdHTTP.Create(nil); IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP); From dff7d2fa13db9c8a61f0cdbdfac0a66295b3c7d1 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 6 Dec 2018 15:30:28 -0200 Subject: [PATCH 193/294] Merge branch 'sp277_71555' into develop --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 79fd51b..8831b9a 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1189,7 +1189,7 @@ function TestConnection(const url: String): boolean; HTTPClient.ReadTimeout := 30000; HTTPClient.ConnectTimeout := 30000; - ParametroSistema := TParametroSistemaData.Create(self); + ParametroSistema := TParametroSistemaData.Create(nil); ParametroSistema.MasterDataSet.Open; if ParametroSistema.MasterDataSetENDERECOPROXY.AsString <> '' then HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetENDERECOPROXY.AsString; From e91a6be1dde84aeaab4d1eb0eb7da8cda89b7ab6 Mon Sep 17 00:00:00 2001 From: Claudio Date: Tue, 18 Dec 2018 14:07:06 -0200 Subject: [PATCH 194/294] Ticket_ID: #72314 - Corrigindo do testConnection --- Lib/UtilsUnit.pas | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8831b9a..36a0f12 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1194,12 +1194,13 @@ function TestConnection(const url: String): boolean; if ParametroSistema.MasterDataSetENDERECOPROXY.AsString <> '' then HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetENDERECOPROXY.AsString; if ParametroSistema.MasterDataSetPORTAPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetPORTAPROXY.AsString; + HTTPClient.ProxyParams.ProxyPort := ParametroSistema.MasterDataSetPORTAPROXY.AsInteger; if ParametroSistema.MasterDataSetUSUARIOPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetUSUARIOPROXY.AsString; + HTTPClient.ProxyParams.ProxyUsername := ParametroSistema.MasterDataSetUSUARIOPROXY.AsString; if ParametroSistema.MasterDataSetSENHAPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetSENHAPROXY.AsString; + HTTPClient.ProxyParams.ProxyPassword := ParametroSistema.MasterDataSetSENHAPROXY.AsString; + HTTPClient.ProxyParams.BasicAuthentication := HTTPClient.ProxyParams.ProxyUsername <> ''; try try HTTPClient.Get(url, Stream); From 027277fceff49caebc26c3fdcfe54fc2b0a73eeb Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 14 Jan 2019 10:16:37 -0200 Subject: [PATCH 195/294] ticket_id: #72747 - Publicador funcionar com mais de uma interface de rede --- Datamodules/acCustomSQLMainDataUn.pas | 24 +++++++++++++---------- Lib/UtilsUnit.pas | 28 +++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 10 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 5e6cc7d..4573351 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -449,17 +449,21 @@ function TacCustomSQLMainData.GetServerDatetime(aConnection: TSQLConnection=nil) var Query: TosSQLQuery; begin - Query := GetQuery; - if (aConnection <> nil) then - Query.SQLConnection := aConnection; - try - Query.SQL.Add('select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'); - Query.Open; - Result := Query.Fields[0].AsDatetime; - Query.Close; - finally - FreeQuery(Query); + Query := GetQuery; + if (aConnection <> nil) then + Query.SQLConnection := aConnection; + + try + Query.SQL.Add('select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'); + Query.Open; + Result := Query.Fields[0].AsDatetime; + Query.Close; + finally + FreeQuery(Query); + end; + except + Result := now(); end; end; diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 36a0f12..f7739b4 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -63,6 +63,7 @@ function ConverteStrToDate2(data: string): TDateTime; function ConverteStrToDate3(data: string): TDateTime; function ConverteStrToDate4(data: string): TDateTime; function GetIPAddress: string; +function GetCurrentIpList:TSTringList; function FieldHasChanged(aField : TField):Boolean; procedure CheckChangedFields(aDataSet: TClientDataSet; aChangedFields: TStringList); function ValueIsEmptyNull(aValue : Variant):Boolean; @@ -820,6 +821,33 @@ function GetIPAddress: string; Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); end; +Function GetCurrentIpList:TSTringList; +type + TaPInAddr = array [0..10] of PInAddr; + PaPInAddr = ^TaPInAddr; +var + phe : PHostEnt; + pptr : PaPInAddr; + Buffer : array [0..63] of char; + I : Integer; + GInitData : TWSADATA; +begin + Result:=TStringList.Create; + WSAStartup($101, GInitData); + GetHostName(Buffer, SizeOf(Buffer)); + phe :=GetHostByName(buffer); + if phe = nil then + Exit; + pptr := PaPInAddr(Phe^.h_addr_list); + I := 0; + while pptr^[I] <> nil do + begin + result.add(StrPas(inet_ntoa(pptr^[I]^))); + Inc(I); + end; + WSACleanup; +end; + function FormatIP(const ip: string): String; var _ip: TStringList; From 3e819cee2b02e85878ec99990e4e24ee1c686e90 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 14 Jan 2019 10:18:56 -0200 Subject: [PATCH 196/294] ticket_id: #72747 - Publicador funcionar com mais de uma interface de rede --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index f7739b4..b7dde10 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -828,7 +828,7 @@ function GetIPAddress: string; var phe : PHostEnt; pptr : PaPInAddr; - Buffer : array [0..63] of char; + Buffer : array [0..63] of Ansichar; I : Integer; GInitData : TWSADATA; begin From 2b836e2d68f427f14a13a68fc9273b6bd05f1526 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 14 Jan 2019 15:06:50 -0200 Subject: [PATCH 197/294] ticket_id: #72788 - Laudo rascunho, correcao das margens --- Lib/osReportUtils.pas | 48 +++++++++++++++++++++++++++++++++---- Report/acCustomReportUn.pas | 2 +- 2 files changed, 45 insertions(+), 5 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 54726e9..00a1784 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -7,7 +7,7 @@ interface daQueryDataView, ppTypes,daIDE, daDBExpress, ppCTDsgn, raIDE, myChkBox, ppModule, FMTBcd, osCustomDataSetProvider, SqlExpr, osSQLDataSetProvider, daSQl, osSQLQuery, osComboFilter, ppDBPipe, osClientDataSet, - acReportContainer, Forms, osCustomMainFrm; + acReportContainer, Forms, osCustomMainFrm, acCustomReportUn; type TIdade = class private @@ -32,7 +32,7 @@ type TIdade = class function getTemplateByName(name: string; stream: TMemoryStream): boolean; function getTemplateByID(id: integer; stream: TMemoryStream): boolean; function getTemplateIDByName(name: string): integer; - function getTemplateLaudoRascunho(name: string; stream: TMemoryStream): boolean; + function getTemplateLaudoRascunho(name: string; stream: TMemoryStream; var config: TConfigImpressao): boolean; procedure replaceReportSQL(report: TppReport; template: TMemoryStream; strSQL: String); procedure replaceReportSQLAddParam(report: TppReport; template: TMemoryStream; @@ -93,11 +93,12 @@ function getTemplateByName(name: string; stream: TMemoryStream): boolean; end; -function getTemplateLaudoRascunho(name: string; stream: TMemoryStream): boolean; +function getTemplateLaudoRascunho(name: string; stream: TMemoryStream; var config: TConfigImpressao): boolean; var query: TosSQLQuery; report: string; ss: TStringStream; + vIdRelatorio: Integer; begin name := UpperCase(Name); Result := false; @@ -106,7 +107,8 @@ function getTemplateLaudoRascunho(name: string; stream: TMemoryStream): boolean; query.SQLConnection := acCustomSQLMainData.SQLConnectionMeta; query.CommandText := ' SELECT ' + ' I.template, '+ - ' I.ITEM_ID '+ + ' I.ITEM_ID, '+ + ' r.IdRelatorio '+ ' FROM ' + ' RB_ITEM I '+ ' join relatorio r on r.item_id = I.item_id '+ @@ -120,6 +122,44 @@ function getTemplateLaudoRascunho(name: string; stream: TMemoryStream): boolean; addReport(query.fields[1].AsInteger, name, TBLOBField(query.fields[0]).AsString); Result := true; end; + + if Result then + begin + vIdRelatorio := query.FieldByName('IdRelatorio').AsInteger; + query.Close; + query.SQL.Text := ' select r.margemsuperior, ' + + ' r.margeminferior, ' + + ' r.margemesquerda, ' + + ' r.margemdireita, ' + + ' r.alturapapel, ' + + ' r.largurapapel, ' + + ' r.orientation, ' + + ' r.classeimpressora, ' + + ' r.tiposaida, ' + + ' rb.item_id from relatorio r'+ + ' join rb_item rb on r.item_id = rb.item_id'+ + ' where r.idrelatorio = '+IntToStr(vIdRelatorio); + query.Open; + if not query.IsEmpty then + begin + if not query.fieldByName('orientation').IsNull then + config.orientation := query.fieldByName('orientation').AsInteger; + if not query.fieldByName('larguraPapel').IsNull then + config.larguraPapel := query.fieldByName('larguraPapel').AsInteger; + if not query.fieldByName('alturaPapel').IsNull then + config.alturaPapel := query.fieldByName('alturaPapel').AsInteger; + if not query.fieldByName('margemSuperior').IsNull then + config.margemSuperior := query.fieldByName('margemSuperior').AsInteger; + if not query.fieldByName('margemInferior').IsNull then + config.margemInferior := query.fieldByName('margemInferior').AsInteger; + if not query.fieldByName('margemEsquerda').IsNull then + config.margemEsquerda := query.fieldByName('margemEsquerda').AsInteger; + if not query.fieldByName('margemDireita').IsNull then + config.margemDireita := query.fieldByName('margemDireita').AsInteger; + // if not query.fieldByName('tipoSaida').IsNull then + // config.tipoSaida := query.fieldByName('tipoSaida').AsString; + end; + end; finally FreeAndNil(query); end; diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index bf1e2b5..d4ddb38 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -166,7 +166,7 @@ procedure TacCustomReport.Print(const PID: integer); //chance da classe buscar seu template if (not encontrou) and (self.RecursoOrigem = 'Aprovação Resultados') then begin - encontrou := getTemplateLaudoRascunho(ClassName, stream); + encontrou := getTemplateLaudoRascunho(ClassName, stream, config); if acCustomParametroSistemaData <> nil then config.nomeImpressora := acCustomParametroSistemaData.getNomeImpressoraClasse('LASER'); end; From 97ae3303197483ecde9951732f65731c79a2b106 Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 23 Jan 2019 10:33:17 -0200 Subject: [PATCH 198/294] Tciekt_ID: #72964 - Passando conn no testconnection para ser utilizado pelo agendador --- Lib/UtilsUnit.pas | 48 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 36 insertions(+), 12 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index b7dde10..f30241e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -83,7 +83,7 @@ function TextFromBase64(const text: String): string; function BinaryFromBase64(const base64: string): TBytesStream; function Base64ToBitmap(base64Field: TBlobField): TBitmap; function Base64FromStream(const input: TStream): string; -function TestConnection(const url: String): boolean; +function TestConnection(const url: String; conn: TosSQLConnection = nil): boolean; function SortCustomClientDataSet(ClientDataSet: TClientDataSet; const FieldName: string): Boolean; function getUriUrlStatus(const address: String; stream: TStream; AOwner: TComponent=nil): Boolean; @@ -1199,12 +1199,13 @@ function Base64ToBitmap(base64Field: TBlobField): TBitmap; end; end; -function TestConnection(const url: String): boolean; +function TestConnection(const url: String; conn: TosSQLConnection = nil): boolean; var HTTPClient: TidHTTP; Stream: TStringStream; LHandler: TIdSSLIOHandlerSocketOpenSSL; ParametroSistema: TParametroSistemaData; + qryProxy: TosSQLQuery; begin Stream := TStringStream.Create('', TEncoding.UTF8); @@ -1217,16 +1218,39 @@ function TestConnection(const url: String): boolean; HTTPClient.ReadTimeout := 30000; HTTPClient.ConnectTimeout := 30000; - ParametroSistema := TParametroSistemaData.Create(nil); - ParametroSistema.MasterDataSet.Open; - if ParametroSistema.MasterDataSetENDERECOPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetENDERECOPROXY.AsString; - if ParametroSistema.MasterDataSetPORTAPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyPort := ParametroSistema.MasterDataSetPORTAPROXY.AsInteger; - if ParametroSistema.MasterDataSetUSUARIOPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyUsername := ParametroSistema.MasterDataSetUSUARIOPROXY.AsString; - if ParametroSistema.MasterDataSetSENHAPROXY.AsString <> '' then - HTTPClient.ProxyParams.ProxyPassword := ParametroSistema.MasterDataSetSENHAPROXY.AsString; + if conn = nil then + begin + ParametroSistema := TParametroSistemaData.Create(nil); + ParametroSistema.MasterDataSet.Open; + if ParametroSistema.MasterDataSetENDERECOPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetENDERECOPROXY.AsString; + if ParametroSistema.MasterDataSetPORTAPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyPort := ParametroSistema.MasterDataSetPORTAPROXY.AsInteger; + if ParametroSistema.MasterDataSetUSUARIOPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyUsername := ParametroSistema.MasterDataSetUSUARIOPROXY.AsString; + if ParametroSistema.MasterDataSetSENHAPROXY.AsString <> '' then + HTTPClient.ProxyParams.ProxyPassword := ParametroSistema.MasterDataSetSENHAPROXY.AsString; + end + else + begin + try + qryProxy := TosSQLQuery.Create(nil); + qryProxy.SQLConnection := conn; + qryProxy.CommandText := 'select ENDERECOPROXY, PORTAPROXY, USUARIOPROXY, SENHAPROXY from PARAMETROSISTEMA'; + qryProxy.Open; + + if not ValueIsEmptyNull(qryProxy.FieldByName('ENDERECOPROXY').Value) then + HTTPClient.ProxyParams.ProxyServer := ParametroSistema.MasterDataSetENDERECOPROXY.AsString; + if not ValueIsEmptyNull(qryProxy.FieldByName('PORTAPROXY').Value) then + HTTPClient.ProxyParams.ProxyPort := ParametroSistema.MasterDataSetPORTAPROXY.AsInteger; + if not ValueIsEmptyNull(qryProxy.FieldByName('USUARIOPROXY').Value) then + HTTPClient.ProxyParams.ProxyUsername := ParametroSistema.MasterDataSetUSUARIOPROXY.AsString; + if not ValueIsEmptyNull(qryProxy.FieldByName('SENHAPROXY').Value) then + HTTPClient.ProxyParams.ProxyPassword := ParametroSistema.MasterDataSetSENHAPROXY.AsString; + finally + FreeAndNil(qryProxy); + end; + end; HTTPClient.ProxyParams.BasicAuthentication := HTTPClient.ProxyParams.ProxyUsername <> ''; try From 6233529eb2db9b30ed3217f67d607e320f712672 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 14 Feb 2019 10:52:35 -0300 Subject: [PATCH 199/294] removendo warnings --- Datamodules/acCustomSQLMainDataUn.pas | 4 +- Forms/FilterDefEditFormUn.pas | 2 +- Forms/ImprimirRelatorioFormUn.pas | 2 +- Forms/ShowEventoLogFormUn.pas | 2 - Forms/osCustomEditFrm.pas | 2 +- Forms/osCustomMainFrm.pas | 37 +++++++++--------- Forms/osWizFrm.pas | 2 +- Lib/UtilsUnit.pas | 13 ++++--- Lib/UtilsUnitGUI.pas | 56 --------------------------- Lib/osCalculaFormulas.pas | 6 +-- Lib/osErrorHandler.pas | 2 +- Lib/osLogin.pas | 4 +- Lib/osMaquina.pas | 2 - Lib/osParser.pas | 30 +++++++------- Lib/osParserErrorHand.pas | 2 +- Lib/osReportUtils.pas | 7 ---- Lib/osShellAPI.pas | 4 +- Report/acCustomReportUn.pas | 15 ++++--- 18 files changed, 64 insertions(+), 128 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 4573351..42d9b03 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -148,7 +148,7 @@ procedure TacCustomSQLMainData.CheckVersion(PTableFilter: string); begin Application.ProcessMessages; - RefreshTable := FindRefreshTable(Trim(NomeTabelaField.Value)); + RefreshTable := FindRefreshTable(Trim(String(NomeTabelaField.Value))); if (RefreshTable <> nil) then begin if RefreshTable.FVersion < VersaoField.Value then @@ -277,7 +277,7 @@ procedure TacCustomSQLMainData.LoadRefreshTables; while not Query.Eof do begin RefreshTable := TRefreshTable.Create; - RefreshTable.FTableName := Trim(NomeTabelaField.Value); + RefreshTable.FTableName := Trim(String(NomeTabelaField.Value)); RefreshTable.FVersion := VersaoField.Value; RefreshTable.FDataSet := nil; diff --git a/Forms/FilterDefEditFormUn.pas b/Forms/FilterDefEditFormUn.pas index 0f70f2a..04683b8 100644 --- a/Forms/FilterDefEditFormUn.pas +++ b/Forms/FilterDefEditFormUn.pas @@ -212,7 +212,7 @@ procedure TFilterDefEditForm.RBComboSearchReturnSearch(Sender: TObject; begin if not(cdsEditDetail.State in [dsEdit, dsInsert]) then cdsEditDetail.Edit; - cdsEditDetailQueryText.Value := getSQLFromTemplate(stream); + cdsEditDetailQueryText.Value := AnsiString(getSQLFromTemplate(stream)); end; finally diff --git a/Forms/ImprimirRelatorioFormUn.pas b/Forms/ImprimirRelatorioFormUn.pas index 8c5b6c2..1dbd2b7 100644 --- a/Forms/ImprimirRelatorioFormUn.pas +++ b/Forms/ImprimirRelatorioFormUn.pas @@ -55,7 +55,7 @@ procedure TImprimirRelatorioForm.ImprimirRelatorioComFiltro(idRelatorio: integer templateName, FilterName: string; srchForm: TCustomSearchForm; config: TConfigImpressao; - sql, extensao: string; + extensao: string; FTextFileName: string; where, order: string; begin diff --git a/Forms/ShowEventoLogFormUn.pas b/Forms/ShowEventoLogFormUn.pas index 4a1e30e..a3f9a40 100644 --- a/Forms/ShowEventoLogFormUn.pas +++ b/Forms/ShowEventoLogFormUn.pas @@ -38,8 +38,6 @@ implementation class procedure TShowEventoLogForm.execute(Usuario: string; datahora: TDateTime; Evento, detalhes: string); -var - frm: TShowEventoLogForm; begin with TShowEventoLogForm.create(nil) do begin diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 2b26118..0001889 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -9,7 +9,7 @@ interface ToolWin, ExtCtrls, osActionList, osClientDataset, provider, osUtils, Grids, Wwdbigrd, Wwdbgrid, wwdbdatetimepicker, wwrcdpnl, Mask, wwdbedit, wwriched, osComboSearch, osDBDualTree, wwDBSpin, wwDBNavigator, wwDBcomb, wwDBlook, DBGrids, - System.Actions; + System.Actions, System.UITypes; type TFormMode = (fmEdit, fmInsert, fmView, fmDelete); diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 800f453..0a7b3f4 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -16,7 +16,8 @@ interface ppModule, daDataModule, FMTBcd, osCustomDataSetProvider, osSQLDataSetProvider, daSQl, daQueryDataView, ppTypes, acCustomReportUn, osSQLQuery, acFilterController, CommCtrl, clipbrd, osCustomLoginFormUn, - acReportContainer, ppParameter, Data.DBXInterBase, System.Actions, Vcl.Samples.Spin, W7Classes, W7Buttons; + acReportContainer, ppParameter, Data.DBXInterBase, System.Actions, Vcl.Samples.Spin, W7Classes, W7Buttons, + System.UITypes; type TDatamoduleClass = class of TDatamodule; @@ -204,7 +205,6 @@ TosCustomMainForm = class(TosForm) FActionDblClick: TAction; FSelectedList: TStringListExt; FSelectionField: TField; - lastValidSentence: string; // Field que está sendo usado para ordenação SortField: TField; @@ -295,7 +295,6 @@ constructor TosCustomMainForm.Create(AOwner: TComponent); sName : string; i : integer; qry: TosSQLQuery; - vViews: variant; begin inherited; FIndiceMenu := 0; @@ -510,8 +509,7 @@ procedure TosCustomMainForm.CheckActionsExecute(Sender: TObject); ComponentNotFound := False; ComponentIsNotAction := False; - if FilterDataset.active then - DataSetIsEmpty := FilterDataset.RecordCount = 0; + DataSetIsEmpty := (FilterDataset.active) and (FilterDataset.RecordCount = 0); ActionDataSet.Open; @@ -1133,7 +1131,6 @@ function TosCustomMainForm.Login: boolean; cds: TosClientDataSet; ErrorCount: integer; LoginCorrect: boolean; - vViews: variant; begin FUserName := GetSystemUserName; @@ -1269,8 +1266,6 @@ function TosCustomMainForm.Login: boolean; end; procedure TosCustomMainForm.Logout; -var - i: integer; begin FilterDataSet.Close; @@ -1316,20 +1311,25 @@ procedure TosCustomMainForm.LoadTreeView; noPai, no: TTreeNode; begin sDomain := ''; - for i:=0 to Manager.Resources.Count - 1 do - begin - with Manager.Resources[i] do + noPai := TTreeNode.Create(nil); + try + for i:=0 to Manager.Resources.Count - 1 do begin - if DomainName <> sDomain then + with Manager.Resources[i] do begin - sDomain := DomainName; - noPai := TreeView1.Items.Add(nil, sDomain); + if DomainName <> sDomain then + begin + sDomain := DomainName; + noPai := TreeView1.Items.Add(nil, sDomain); + end; + // Cria o botão + no := TreeView1.Items.AddChild(noPai, name); + no.ImageIndex := ImageIndex; + no.SelectedIndex := Manager.Resources[i].ID; end; - // Cria o botão - no := TreeView1.Items.AddChild(noPai, name); - no.ImageIndex := ImageIndex; - no.SelectedIndex := Manager.Resources[i].ID; end; + finally + FreeAndNil(noPai); end; end; @@ -1840,7 +1840,6 @@ procedure TosCustomMainForm.GridCalcCellColors(Sender: TObject; Field: TField; State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush); var - dummy: integer; id: integer; begin inherited; diff --git a/Forms/osWizFrm.pas b/Forms/osWizFrm.pas index f13850c..552c01b 100644 --- a/Forms/osWizFrm.pas +++ b/Forms/osWizFrm.pas @@ -5,7 +5,7 @@ interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, osUtils, ActnList, osActionList, osFrm, - System.Actions; + System.Actions, System.UITypes; type TosWizForm = class(TosForm) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index f30241e..7cba375 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -149,7 +149,7 @@ function ApenasNumeros(const valor : String) : String; begin Result := EmptyStr; for i := 1 to length(valor) do - if valor[i] in ['0'..'9'] then + if CharInSet(valor[i], ['0'..'9']) then Result := result + valor[i]; end; @@ -842,7 +842,7 @@ function GetIPAddress: string; I := 0; while pptr^[I] <> nil do begin - result.add(StrPas(inet_ntoa(pptr^[I]^))); + result.add(String(inet_ntoa(pptr^[I]^))); Inc(I); end; WSACleanup; @@ -1072,7 +1072,7 @@ function Base64FromBinary(const FileName: String): string; Encoder: TIdEncoderMIME; begin Result := EmptyStr; - Output := EmptyStr; + Output := UTF8Encode(EmptyStr); Input := TFileStream.Create(FileName, fmOpenRead); InputMemoryStream := TMemoryStream.Create(); @@ -1080,8 +1080,8 @@ function Base64FromBinary(const FileName: String): string; try //Soap.EncdDecd.EncodeStream(Input, Output); InputMemoryStream.LoadFromStream(Input); - Output := Encoder.EncodeStream(InputMemoryStream, InputMemoryStream.Size); - Result := Output; + Output := UTF8Encode(Encoder.EncodeStream(InputMemoryStream, InputMemoryStream.Size)); + Result := UTF8ToString(Output); finally FreeAndNil(Input); FreeAndNil(InputMemoryStream); @@ -1822,9 +1822,11 @@ function GetFileSize(const filename: widestring): Int64; begin Result := -1; try + {$WARNINGS OFF} if ((FileExists(filename)) and (FindFirst(filename, faAnyFile, sr) = 0)) then Result := Int64(sr.FindData.nFileSizeHigh) shl Int64(32) + Int64(sr.FindData.nFileSizeLow); + {$WARNINGS ON} finally FindClose(sr); end; @@ -1924,6 +1926,7 @@ procedure ParseJSONObject(aDict: TKeyValue; aJsonValue: TJSONValue; _jsonString: TJSONString; _jsonValue: TJSONValue; begin + _jsonString := nil; // ... IS A JSONObject? if (aJsonValue is TJSONObject) then begin diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 5080345..8bd0c86 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -50,14 +50,10 @@ function GetProcessList: string; function GetSystemInfo: string; function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; -function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; procedure ExecuteAndWait(const aCommando: string); function Execute(const aCommando: string; const ShowWindow: boolean; var aProcessInformation: TProcessInformation): boolean; procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); procedure CloseProcess(const aProcessInformation: TProcessInformation); -function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; function LocalIp: string; implementation @@ -739,30 +735,6 @@ function GetSystemInfo: string; //Result := GetSystemDecimal; end; -function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; -var - dwResult: PDWORD_PTR; - ValorRetorno: Longint; - AppHandle : THandle; -begin - Result := False; - - try - AppHandle:= UtilsUnitGui.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); - if AppHandle <> 0 then - begin - ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, - SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); - if ValorRetorno > 0 then - Result := True - else - Result := False; - end; - except - end; -end; - procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); begin if enabled then @@ -780,34 +752,6 @@ procedure setHabilitaComboSearch(cbo: TosComboSearch; enabled: boolean); cbo.invalidate; end; -function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; - var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; -var - ContinueLoop: BOOL; - FSnapshotHandle: THandle; - FProcessEntry32: TProcessEntry32; -begin - FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); - try - FProcessEntry32.dwSize := SizeOf(FProcessEntry32); - ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); - Result := False; - while Integer(ContinueLoop) <> 0 do - begin - if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = - UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = - UpperCase(ExeFileName))) then - begin - Result := True; - ValidaTravamento(UpperCase(ExeFileName), FTaskName, FPid, FProcessa, FHWND, iListOfProcess); - end; - ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); - end; - finally - CloseHandle(FSnapshotHandle); - end; -end; - function LocalIp: string; var IPW: TIdIPWatch; diff --git a/Lib/osCalculaFormulas.pas b/Lib/osCalculaFormulas.pas index ee6fc8f..0cd70da 100644 --- a/Lib/osCalculaFormulas.pas +++ b/Lib/osCalculaFormulas.pas @@ -169,7 +169,7 @@ function TosCalculaFormulas.Inicializa : boolean; while Index < Count do begin // atribui expressao para que o parser processe-a - Parser.Expressao := TosFormula(Elementos[Index]).Formula; + Parser.Expressao := AnsiString(String(TosFormula(Elementos[Index]).Formula)); if Parser.Expressao <> '' then begin // compila a expressao @@ -273,7 +273,7 @@ function TosFormula.NumErrosExpr: Integer; function TosFormula.Processa(Dependencias: TListaElementos): Boolean; begin - FParser.Expressao := FFormula; + FParser.Expressao := AnsiString(String(FFormula)); if not(FParser.Compile) then FListaErrosExpr.Assign(FParser.ListaErros); @@ -309,7 +309,7 @@ function TosFormulaCalc.Processa(Dependencias: TListaElementos): Boolean; VariavelAdj : TosFormulaVariavel; begin // avaliacao da expressao - FParser.Expressao := FFormula; + FParser.Expressao := AnsiString(String(FFormula)); if not(FParser.Compile) then FListaErrosExpr.Assign(FParser.ListaErros); diff --git a/Lib/osErrorHandler.pas b/Lib/osErrorHandler.pas index 7dfc9c5..9657a15 100644 --- a/Lib/osErrorHandler.pas +++ b/Lib/osErrorHandler.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, db, osCIC, richedit, RegExpr; + Dialogs, StdCtrls, db, osCIC, richedit, RegExpr, System.Types; type TErrorType = (etError, etCritical, etWarning); diff --git a/Lib/osLogin.pas b/Lib/osLogin.pas index c8a3526..805036d 100644 --- a/Lib/osLogin.pas +++ b/Lib/osLogin.pas @@ -4,7 +4,7 @@ interface uses Windows, SysUtils, osSQLDataSet, acCustomSQLMainDataUn, Controls, Dialogs, - osCustomLoginFormUn; + osCustomLoginFormUn, System.UITypes; type TLoginUsuario = class @@ -199,4 +199,4 @@ procedure TLoginUsuario.Logout; end; end. - \ No newline at end of file + diff --git a/Lib/osMaquina.pas b/Lib/osMaquina.pas index a366c52..969ea5c 100644 --- a/Lib/osMaquina.pas +++ b/Lib/osMaquina.pas @@ -343,8 +343,6 @@ function TosMaquina.Exec: Boolean; procedure TosMaquina.ProcessaInstrucao(bytecode: Integer; Parametro: String); var ValorVar: ^Double; - ValorString: PAnsiChar; - stringVar: string; doubleAux: Double; Variavel: TVariavelMaquina; begin diff --git a/Lib/osParser.pas b/Lib/osParser.pas index ddade48..b3eb776 100644 --- a/Lib/osParser.pas +++ b/Lib/osParser.pas @@ -2,7 +2,7 @@ interface -uses osLex, Classes, SysUtils, osParserErrorHand; +uses osLex, Classes, SysUtils, osParserErrorHand, System.Types; type // representa uma pilha generica @@ -201,12 +201,12 @@ constructor TosParser.Create; procedure TosParser.NovaExpressao(Expr: AnsiString); begin FCompilado := False; - FLex.Expressao := AnsiUpperCase(Expr); + FLex.Expressao := AnsiUpperCase(AnsiString(Expr)); end; function TosParser.ObtemExpressao: AnsiString; begin - Result := FLex.Expressao; + Result := AnsiString(FLex.Expressao); end; { Confere token atual e le o proximo token } @@ -535,49 +535,49 @@ procedure TExprPrograma.Clear; procedure TExprPrograma.emit_ConstBool(Num: String); begin - FFonte := FFonte + 'constbool:' + Num + #13#10; + FFonte := FFonte + 'constbool:' + AnsiString(Num) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_ConstNum(Num: String); begin - FFonte := FFonte + 'constnum:' + Num + #13#10; + FFonte := FFonte + 'constnum:' + AnsiString(Num) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_Func(NomeFunc: String); begin - FFonte := FFonte + 'func:' + Nomefunc + #13#10; + FFonte := FFonte + 'func:' + AnsiString(Nomefunc) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_FuncArg(NumArgumentos: Integer); begin - FFonte := FFonte + 'arg:' + IntToStr(NumArgumentos) + #13#10; + FFonte := FFonte + 'arg:' + AnsiString(IntToStr(NumArgumentos)) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_LValor(NomeVariavel: String); begin - FFonte := FFonte + 'lvalue:' + NomeVariavel + #13#10; + FFonte := FFonte + 'lvalue:' + AnsiString(NomeVariavel) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_Operador(Operador: String); begin - FFonte := FFonte + 'op:' + Operador + #13#10; + FFonte := FFonte + 'op:' + AnsiString(Operador) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_OperadorUnario(Operador: String); begin - FFonte := FFonte + 'opun:' + Operador + #13#10; + FFonte := FFonte + 'opun:' + AnsiString(Operador) + #13#10; inc(FnLinhas); end; procedure TExprPrograma.emit_RValor(NomeVariavel: String); begin - FFonte := FFonte + 'rvalue:' + NomeVariavel + #13#10; + FFonte := FFonte + 'rvalue:' + AnsiString(NomeVariavel) + #13#10; inc(FnLinhas); end; @@ -589,23 +589,23 @@ function TExprPrograma.LeLinha(Index: Integer): String; begin i := 0; PosI := 1; - PosF := AnsiPos(#13#10, FFonte);; + PosF := AnsiPos(#13#10, String(FFonte));; Tamanho := Length(FFonte); while i < Index do begin PosI := PosF + 2; - PosF := PosI + AnsiPos(#13#10, Copy(FFonte, PosI, Tamanho - PosI + 1)) - 1; + PosF := PosI + AnsiPos(#13#10, Copy(String(FFonte), PosI, Tamanho - PosI + 1)) - 1; inc(i); end; - Result := Copy(FFonte, PosI, PosF-PosI); + Result := Copy(String(FFonte), PosI, PosF-PosI); end; procedure TExprPrograma.emit_ConstString(str: String); begin - FFonte := FFonte + 'conststring:' + str + #13#10; + FFonte := FFonte + 'conststring:' + AnsiString(str) + #13#10; inc(FnLinhas); end; diff --git a/Lib/osParserErrorHand.pas b/Lib/osParserErrorHand.pas index 5ce4ddd..1ad456a 100644 --- a/Lib/osParserErrorHand.pas +++ b/Lib/osParserErrorHand.pas @@ -37,7 +37,7 @@ constructor TNodoErro.Create(pClasse: TClasseErr; pIDErro: Integer; begin FClasse := pClasse; FIDErro := pIDErro; - FTexto := Format(pTexto, ListaDeComplementos); + FTexto := AnsiString(Format(String(pTexto), ListaDeComplementos)); end; { TListErro } diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 00a1784..9e08b53 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -96,8 +96,6 @@ function getTemplateByName(name: string; stream: TMemoryStream): boolean; function getTemplateLaudoRascunho(name: string; stream: TMemoryStream; var config: TConfigImpressao): boolean; var query: TosSQLQuery; - report: string; - ss: TStringStream; vIdRelatorio: Integer; begin name := UpperCase(Name); @@ -477,12 +475,10 @@ function TIdade.getAnos: integer; var dia, mes, ano: word; diaAtual, mesAtual, anoAtual: word; - dataFinal: TDateTime; numAnos: integer; begin DecodeDate(dataReferencia, anoAtual, mesAtual, diaAtual); DecodeDate(dataReferencia-Fdias, ano, mes, dia); - dataFinal := dataReferencia; //calcular o número de anos que a pessoa possui numAnos := anoAtual - ano; @@ -499,12 +495,10 @@ function TIdade.getMeses: integer; var dia, mes, ano: word; diaAtual, mesAtual, anoAtual: word; - dataFinal: TDateTime; numMeses: integer; begin DecodeDate(dataReferencia, anoAtual, mesAtual, diaAtual); DecodeDate(dataReferencia-Fdias, ano, mes, dia); - dataFinal := dataReferencia; //calcular o número de meses que a pessoa possui numMeses := getAnos*12; @@ -535,7 +529,6 @@ function TIdade.getString: string; Total_dias: Real; Count: Integer; begin - Total_dias := Fdias; Count:= 1; DataNascimento:= FdataReferencia - Fdias; diff --git a/Lib/osShellAPI.pas b/Lib/osShellAPI.pas index ea06d1f..02bd86d 100644 --- a/Lib/osShellAPI.pas +++ b/Lib/osShellAPI.pas @@ -345,7 +345,7 @@ function ShShowMessage(Mensagem : String; msStyle : TShMessageStyle) : boolean; s : String; Flags : LongInt; begin - + Flags := 0; s := Application.ExeName; if Application.Title <> '' then s := Application.Title; @@ -450,6 +450,8 @@ function ExecuteWait(const p_commandLine : string; const p_commandShow: Word) : bRet : boolean; begin StrPCopy(pCommandLine, p_commandLine); + hAppThread := 0; + hAppProcess := 0; TRY { Prepare StartupInfo structure } FillChar(StartupInfo, SizeOf(StartupInfo), #0); diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index d4ddb38..435c12f 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -91,7 +91,8 @@ TacCustomReport = class(TDataModule) property forcePreview: Boolean read FForcePreview write setForcePreview; property PDFStream: TMemoryStream read FPDFStream write FPDFStream; property PrintToStream: Boolean read FPrintToStream write FPrintToStream; - procedure Print(const PID: integer); virtual; + procedure Print(const PID: integer); overload; virtual; + procedure Print(PID, reportId: integer); overload; virtual; function getPipeline(name: String): TppDataPipeline; function findComponentUserName(name: String): TComponent; procedure SetOutputFile(FileName: string; Format: TReportFormat = rfPrinter); @@ -120,6 +121,11 @@ procedure TacCustomReport.linkEvents; // end; +procedure TacCustomReport.Print(PID, reportId: integer); +begin + Print(PID); +end; + {------------------------------------------------------------------------- ESTE MÉTODO PRECISA URGENTE DE UMA REFACTORING TOTAL - para piorar esta lógica está duplicada em: TImprimirRelatorioForm.ImprimirRelatorioComFiltro @@ -330,14 +336,11 @@ procedure TacCustomReport.DataModuleCreate(Sender: TObject); function TacCustomReport.getPipeline(name: String): TppDataPipeline; var - aSQL: TDaSQL; lDataModule: TdaDataModule; liIndex, i: Integer; lDataView: TdaDataView; nomePipeline: String; begin - aSQL := nil; - lDataModule := daGetDataModule(Report.MainReport); if (lDataModule <> nil) then @@ -375,8 +378,6 @@ procedure TacCustomReport.replaceReportSQLAddWhere(report: TppReport; template: if template.Size <> 0 then report.Template.LoadFromStream(template); - aSQL := nil; - lDataModule := daGetDataModule(Report.MainReport); if (lDataModule <> nil) then @@ -425,8 +426,6 @@ procedure TacCustomReport.replaceReportSQLAddWhere(report: TppReport; template: end; function TacCustomReport.replaceId(str: string; id:integer): string; -var - pos1, pos2, pos3: integer; begin result := StringReplace(str,'\id',IntToStr(id),[rfReplaceAll, rfIgnoreCase]); end; From de1e09cb93f501ea67f0e9986ca38c4c5ae4eff1 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 19 Feb 2019 15:23:13 -0300 Subject: [PATCH 200/294] removendo warnings --- Forms/osCustomMainFrm.pas | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 0a7b3f4..67cf4c6 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1311,25 +1311,20 @@ procedure TosCustomMainForm.LoadTreeView; noPai, no: TTreeNode; begin sDomain := ''; - noPai := TTreeNode.Create(nil); - try - for i:=0 to Manager.Resources.Count - 1 do + for i:=0 to Manager.Resources.Count - 1 do + begin + with Manager.Resources[i] do begin - with Manager.Resources[i] do + if DomainName <> sDomain then begin - if DomainName <> sDomain then - begin - sDomain := DomainName; - noPai := TreeView1.Items.Add(nil, sDomain); - end; - // Cria o botão - no := TreeView1.Items.AddChild(noPai, name); - no.ImageIndex := ImageIndex; - no.SelectedIndex := Manager.Resources[i].ID; + sDomain := DomainName; + noPai := TreeView1.Items.Add(nil, sDomain); end; + // Cria o botão + no := TreeView1.Items.AddChild(noPai, name); + no.ImageIndex := ImageIndex; + no.SelectedIndex := Manager.Resources[i].ID; end; - finally - FreeAndNil(noPai); end; end; From 57a1c25c380673f285868ac9250b074aafa08c61 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 20 Feb 2019 09:18:47 -0300 Subject: [PATCH 201/294] Adicionando ao Create do MainData uma condicacao que controla o refresh dos lookups, evitando a chamada desnecessaria que deixava alguns pontos mais lentos --- Datamodules/acCustomSQLMainDataUn.pas | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 4573351..c5ea6bb 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -71,7 +71,7 @@ TacCustomSQLMainData = class(TDataModule) property Profile: string read FProfile; - constructor Create(AOwner: TComponent); overload; override; + constructor Create(AOwner: TComponent; RefreshTables: Boolean = True); overload; constructor Create(AOwner: TComponent; BD: String); overload; destructor Destroy; override; function GetNetUserName: string; @@ -171,11 +171,12 @@ procedure TacCustomSQLMainData.CheckVersion(PTableFilter: string);  Observações> Comentario iniciado em 23.06.2006 por Ricardo N. Acras  Atualização>  ------------------------------------------------------------------------} -constructor TacCustomSQLMainData.Create(AOwner: TComponent); +constructor TacCustomSQLMainData.Create(AOwner: TComponent; RefreshTables: Boolean = True); begin FQueryList := TObjectList.Create(True); // OwnsObjects = True FIDHighValue := -1; - FRefreshTableList := TRefreshTableList.Create; // OwnsObjects = True + if RefreshTables then + FRefreshTableList := TRefreshTableList.Create; // OwnsObjects = True inherited Create(AOwner); end; From b36f751e90f1bcb6f96c69fc4f934b3a51c6da0c Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 20 Feb 2019 10:59:34 -0300 Subject: [PATCH 202/294] desfazendo alteracao do create --- Datamodules/acCustomSQLMainDataUn.pas | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index c5ea6bb..77f6bd4 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -70,8 +70,7 @@ TacCustomSQLMainData = class(TDataModule) property ApelidoUsuario: String read FApelidoUsuario; property Profile: string read FProfile; - - constructor Create(AOwner: TComponent; RefreshTables: Boolean = True); overload; + constructor Create(AOwner: TComponent); overload; override; constructor Create(AOwner: TComponent; BD: String); overload; destructor Destroy; override; function GetNetUserName: string; @@ -171,12 +170,11 @@ procedure TacCustomSQLMainData.CheckVersion(PTableFilter: string);  Observações> Comentario iniciado em 23.06.2006 por Ricardo N. Acras  Atualização>  ------------------------------------------------------------------------} -constructor TacCustomSQLMainData.Create(AOwner: TComponent; RefreshTables: Boolean = True); +constructor TacCustomSQLMainData.Create(AOwner: TComponent); begin FQueryList := TObjectList.Create(True); // OwnsObjects = True FIDHighValue := -1; - if RefreshTables then - FRefreshTableList := TRefreshTableList.Create; // OwnsObjects = True + FRefreshTableList := TRefreshTableList.Create; // OwnsObjects = True inherited Create(AOwner); end; From 13a4a967e87a39f004dca1b0e52d4fb3b65323c5 Mon Sep 17 00:00:00 2001 From: Guilherme Date: Wed, 27 Feb 2019 15:49:07 -0300 Subject: [PATCH 203/294] =?UTF-8?q?ticket=5Fid:=20#73714=20-=20forma=20val?= =?UTF-8?q?idar=20a=20utiliza=C3=A7=C3=A3o=20de=20relat=C3=B3rios=20impres?= =?UTF-8?q?sos.=20Salvando=20no=20Banco=20um=20contador=20incremental=20e?= =?UTF-8?q?=20data=20da=20ultima=20impress=C3=A3o=20do=20relat=C3=B3rio.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/ImprimirRelatorioFormUn.pas | 16 +++++++++++++++- Report/acCustomReportUn.pas | 19 +++++++++++++++++-- 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/Forms/ImprimirRelatorioFormUn.pas b/Forms/ImprimirRelatorioFormUn.pas index 8c5b6c2..1247c6e 100644 --- a/Forms/ImprimirRelatorioFormUn.pas +++ b/Forms/ImprimirRelatorioFormUn.pas @@ -4,7 +4,7 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, osCustomEditFrm, Menus, ImgList, DB, ActnList, osActionList, + Dialogs, osCustomEditFrm, Menus, ImgList, DB, ActnList, osActionList, SQLMainData, Buttons, ExtCtrls, osUtils, DBClient, osClientDataset, StdCtrls, Mask, wwdbedit, Wwdotdot, Wwdbcomb, osComboFilter, osSQLQuery, ppReport, ppComm, ppRelatv, ppProd, ppClass, osCustomSearchFrm, ppMemo, TypInfo, @@ -52,6 +52,7 @@ procedure TImprimirRelatorioForm.ImprimirRelatorioComFiltro(idRelatorio: integer var stream: TMemoryStream; qry: TosSQLQuery; + updateContadorImpressao : TosSQLQuery; templateName, FilterName: string; srchForm: TCustomSearchForm; config: TConfigImpressao; @@ -189,7 +190,20 @@ procedure TImprimirRelatorioForm.ImprimirRelatorioComFiltro(idRelatorio: integer report.DeviceType := 'TextFile'; end; + updateContadorImpressao := MainData.GetQuery; + try + updateContadorImpressao.SQL.Text := 'UPDATE rb_item '+ + ' SET FREQUENCIAUSO = FREQUENCIAUSO+1, '+ + ' DATAULTIMAIMPRESSAO = ' + + QuotedStr(FormatDateTime('dd.mm.yyyy', MainData.GetServerDatetime)) + + ' WHERE ITEM_ID = ' + IntToStr(getTemplateIDByName(TemplateName)); + updateContadorImpressao.ExecSQL; + finally + acCustomSQLMainData.FreeQuery(updateContadorImpressao); + end; + report.Print; + end; procedure TImprimirRelatorioForm.ImprimirTemplate(templateName: string); diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index d4ddb38..878048b 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -4,11 +4,11 @@ interface uses SysUtils, Classes, ppComm, ppRelatv, ppProd, ppClass, ppReport, DB, - DBClient, osClientDataset, osComboFilter, FMTBcd, Provider, + DBClient, osClientDataset, osComboFilter, FMTBcd, Provider, SQLMainData, osCustomDataSetProvider, osSQLDataSetProvider, SqlExpr, osSQLDataSet, ppModule, raCodMod, ppMemo, ppVar, ppBands, ppStrtch, ppSubRpt, ppCtrls, ppPrnabl, ppCache, ppDB, ppDBPipe, ppTypes, Forms, ppViewr, daSQl, - daDataModule, daQueryDataView, TypInfo, Printers, + daDataModule, daQueryDataView, TypInfo, Printers, osSQLQuery, ppPDFDevice, ppPrintr, ppParameter, ppArchiv, System.Zlib; type @@ -129,6 +129,7 @@ procedure TacCustomReport.Print(const PID: integer); var stream: TMemoryStream; idTemplate: integer; + updateContadorImpressao : TosSQLQuery; encontrou: boolean; showCancelDialog: boolean; config: TConfigImpressao; @@ -314,6 +315,20 @@ procedure TacCustomReport.Print(const PID: integer); Report.PrintToDevices; end else + + updateContadorImpressao := MainData.GetQuery; + acCustomRelatorioData.MasterDataSet.Open; + try + updateContadorImpressao.SQL.Text := 'UPDATE rb_item '+ + ' SET FREQUENCIAUSO = FREQUENCIAUSO+1, '+ + ' DATAULTIMAIMPRESSAO = ' + + QuotedStr(FormatDateTime('dd.mm.yyyy', MainData.GetServerDatetime)) + + ' WHERE ITEM_ID = ' + IntToStr(idTemplate); + updateContadorImpressao.ExecSQL; + finally + acCustomSQLMainData.FreeQuery(updateContadorImpressao); + end; + Report.Print; finally FreeAndNil(stream); From 263cbe54a289d0ce5e5a6677665c1af58732baa4 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 12 Mar 2019 09:06:03 -0300 Subject: [PATCH 204/294] =?UTF-8?q?ignorar=20poss=C3=ADvel=20erro=20ao=20t?= =?UTF-8?q?entar=20acessar=20o=20arquivo=20para=20imprimir=20etiquera=20do?= =?UTF-8?q?=20apoio?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnitGUI.pas | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 5080345..58470d9 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -232,32 +232,36 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: SysUtils.DeleteFile(diretorio + 'COMANDO.TXT'); SysUtils.DeleteFile(diretorio + 'PRINTLBL.BAT'); - AssignFile(FComando, diretorio + 'COMANDO.TXT'); try - Rewrite(FComando); - Writeln(FComando, comando); - finally - CloseFile(FComando); - end; + AssignFile(FComando, diretorio + 'COMANDO.TXT'); + try + Rewrite(FComando); + Writeln(FComando, comando); + finally + CloseFile(FComando); + end; - _erroType := diretorio + '\errotype.txt'; - _erroPrint := diretorio + '\erroprint.txt'; + _erroType := diretorio + '\errotype.txt'; + _erroPrint := diretorio + '\erroprint.txt'; - AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); - try - Rewrite(FBat); - Writeln(FBat, Format('(TYPE "%s\COMANDO.TXT" >"%s" 2>%s ) 2>%s',[diretorio, impressora, _erroType, _erroPrint])); - finally - CloseFile(FBat); - end; + AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); + try + Rewrite(FBat); + Writeln(FBat, Format('(TYPE "%s\COMANDO.TXT" >"%s" 2>%s ) 2>%s',[diretorio, impressora, _erroType, _erroPrint])); + finally + CloseFile(FBat); + end; - SysUtils.DeleteFile(_erroType); - SysUtils.DeleteFile(_erroPrint); + SysUtils.DeleteFile(_erroType); + SysUtils.DeleteFile(_erroPrint); - ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); + ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); - erro := UtilsUnit.LoadFromFile(_erroType); - erro := erro + StrUtils.IfThen(erro.IsEmpty, #13#10) + UtilsUnit.LoadFromFile(_erroPrint); + erro := UtilsUnit.LoadFromFile(_erroType); + erro := erro + StrUtils.IfThen(erro.IsEmpty, #13#10) + UtilsUnit.LoadFromFile(_erroPrint); + except + + end; end; function ConverteRTF(rtf: string): string; From 0e08f4614f193de0774c1d4e2d734504e90d4fac Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 13 Mar 2019 10:51:56 -0300 Subject: [PATCH 205/294] removendo warnings --- Datamodules/acCustomSQLMainDataUn.pas | 4 ++-- Forms/osCustomMainFrm.dfm | 1 + Forms/osCustomMainFrm.pas | 2 ++ Lib/osParser.pas | 2 +- 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 215848e..202b5c6 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -71,7 +71,7 @@ TacCustomSQLMainData = class(TDataModule) property Profile: string read FProfile; constructor Create(AOwner: TComponent); overload; override; - constructor Create(AOwner: TComponent; BD: String); overload; + constructor CreateOwn(AOwner: TComponent; BD: String); overload; destructor Destroy; override; function GetNetUserName: string; @@ -186,7 +186,7 @@ constructor TacCustomSQLMainData.Create(AOwner: TComponent);  Observações>  Atualização>  ------------------------------------------------------------------------} -constructor TacCustomSQLMainData.Create(AOwner: TComponent; bd: string); +constructor TacCustomSQLMainData.CreateOwn(AOwner: TComponent; bd: string); begin Self.Create(AOwner); self.BD := bd; diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index 50ce57d..9fbb655 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -25,6 +25,7 @@ inherited osCustomMainForm: TosCustomMainForm Left = 11 Top = 2 Width = 268 + Height = 22 AutoSize = True ButtonHeight = 32 ButtonWidth = 32 diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 67cf4c6..d39dd13 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1311,6 +1311,7 @@ procedure TosCustomMainForm.LoadTreeView; noPai, no: TTreeNode; begin sDomain := ''; + noPai := nil; for i:=0 to Manager.Resources.Count - 1 do begin with Manager.Resources[i] do @@ -1320,6 +1321,7 @@ procedure TosCustomMainForm.LoadTreeView; sDomain := DomainName; noPai := TreeView1.Items.Add(nil, sDomain); end; + // Cria o botão no := TreeView1.Items.AddChild(noPai, name); no.ImageIndex := ImageIndex; diff --git a/Lib/osParser.pas b/Lib/osParser.pas index b3eb776..12ca697 100644 --- a/Lib/osParser.pas +++ b/Lib/osParser.pas @@ -201,7 +201,7 @@ constructor TosParser.Create; procedure TosParser.NovaExpressao(Expr: AnsiString); begin FCompilado := False; - FLex.Expressao := AnsiUpperCase(AnsiString(Expr)); + FLex.Expressao := AnsiUpperCase(String(Expr)); end; function TosParser.ObtemExpressao: AnsiString; From d9b1ce37e7a123d7aa1a4e2bdb2f09d69078f621 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 18 Mar 2019 12:09:16 -0300 Subject: [PATCH 206/294] correcao de merge, contador de impressao de laudos --- Report/acCustomReportUn.pas | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 878048b..72ef2d5 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -315,9 +315,8 @@ procedure TacCustomReport.Print(const PID: integer); Report.PrintToDevices; end else - + Report.Print; updateContadorImpressao := MainData.GetQuery; - acCustomRelatorioData.MasterDataSet.Open; try updateContadorImpressao.SQL.Text := 'UPDATE rb_item '+ ' SET FREQUENCIAUSO = FREQUENCIAUSO+1, '+ @@ -328,8 +327,6 @@ procedure TacCustomReport.Print(const PID: integer); finally acCustomSQLMainData.FreeQuery(updateContadorImpressao); end; - - Report.Print; finally FreeAndNil(stream); end; From 95b5f455aed16f4f974c644efdafd55900eccc66 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 27 May 2019 10:48:55 -0300 Subject: [PATCH 207/294] =?UTF-8?q?Alterando=20a=20forma=20de=20impress?= =?UTF-8?q?=C3=A3o=20da=20etiqueta,=20nao=20sera=20mais=20feito=20via=20BA?= =?UTF-8?q?T=20e=20sim=20enviando=20ao=20driver=20da=20impressora?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnitGUI.pas | 68 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 57 insertions(+), 11 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 58470d9..faa4173 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -62,7 +62,7 @@ function LocalIp: string; implementation -uses IdIPWatch, IdTCPClient; +uses IdIPWatch, IdTCPClient, WinSpool; procedure setHabilitaButton(btn: TButton; enabled: boolean); begin @@ -225,7 +225,10 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: var FBat, FComando: TextFile; diretorio: string; - _erroType, _erroPrint: string; + cmm, printerName: AnsiString; + I: Integer; + vPrinter : TPrinter; + //_erroType, _erroPrint: string; begin diretorio:= GetSpecialFolderLocation(Application.Handle, CSIDL_COMMON_APPDATA) + '\'; @@ -241,24 +244,67 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: CloseFile(FComando); end; - _erroType := diretorio + '\errotype.txt'; - _erroPrint := diretorio + '\erroprint.txt'; + if length(trim(comando)) > 30 then + begin + vPrinter := TPrinter.Create; + try + for I := 0 to Printer.Printers.Count-1 do + begin + if POS('(', Printer.Printers[I]) > 0 then + begin + if Trim(UpperCase(copy(Printer.Printers[I], 1, POS('(', Printer.Printers[I])-1))) = Trim(UpperCase(copy(Impressora, 1, POS('(', Impressora)-1))) then + begin + vPrinter.PrinterIndex := I; + break; + end; + end + else + begin + if Trim(UpperCase(Printer.Printers[I])) = Trim(UpperCase(copy(Impressora, 1, POS('(', Impressora)-1))) then + begin + vPrinter.PrinterIndex := I; + break; + end; + end; + end; - AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); + //É necessário inicializar o comando com "N" para limpar as configurações da impressora caso ela tenha imprimido algum outro padrão de etiqueta. + //é necessário que haja 2 "N" logo no começo do comando; + cmm := 'N' + #10 + Trim(comando)+#10 + 'N' + #10; + StartDocPrinter(vPrinter.Handle, 1, @cmm); + vPrinter.BeginDoc; + + pword(cmm)^ := length(cmm)-2; + if ExtEscape(vPrinter.Handle, PASSTHROUGH, Length(cmm), pointer(cmm), 0, nil)<0 then + erro := 'Error ao enviar comandos para a impressora'; + EndDocPrinter(vPrinter.Handle); + vPrinter.EndDoc; + finally + FreeAndNil(vPrinter); + end; + end; + + /////////Dessa forma será gerado um arquivo txt e um BAT e o bat executa a impressao, mas apenas para impressoras compartilhadas + /// + /// + //_erroType := diretorio + '\errotype.txt'; + //_erroPrint := diretorio + '\erroprint.txt'; + + {AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); try Rewrite(FBat); Writeln(FBat, Format('(TYPE "%s\COMANDO.TXT" >"%s" 2>%s ) 2>%s',[diretorio, impressora, _erroType, _erroPrint])); finally CloseFile(FBat); - end; + end;} - SysUtils.DeleteFile(_erroType); - SysUtils.DeleteFile(_erroPrint); + //SysUtils.DeleteFile(_erroType); + //SysUtils.DeleteFile(_erroPrint); - ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); + //ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); - erro := UtilsUnit.LoadFromFile(_erroType); - erro := erro + StrUtils.IfThen(erro.IsEmpty, #13#10) + UtilsUnit.LoadFromFile(_erroPrint); + //erro := UtilsUnit.LoadFromFile(_erroType); + //erro := erro + StrUtils.IfThen(erro.IsEmpty, #13#10) + UtilsUnit.LoadFromFile(_erroPrint); except end; From c0f388facfdaa5890bd3caf77696085248932746 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 10 Jul 2019 09:43:10 -0300 Subject: [PATCH 208/294] correcao da impressao de etiquera do apoio --- Lib/UtilsUnitGUI.pas | 41 +++-------------------------------------- 1 file changed, 3 insertions(+), 38 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index faa4173..48148c5 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -62,7 +62,7 @@ function LocalIp: string; implementation -uses IdIPWatch, IdTCPClient, WinSpool; +uses IdIPWatch, IdTCPClient; procedure setHabilitaButton(btn: TButton; enabled: boolean); begin @@ -228,22 +228,8 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: cmm, printerName: AnsiString; I: Integer; vPrinter : TPrinter; - //_erroType, _erroPrint: string; begin - diretorio:= GetSpecialFolderLocation(Application.Handle, CSIDL_COMMON_APPDATA) + '\'; - - SysUtils.DeleteFile(diretorio + 'COMANDO.TXT'); - SysUtils.DeleteFile(diretorio + 'PRINTLBL.BAT'); - try - AssignFile(FComando, diretorio + 'COMANDO.TXT'); - try - Rewrite(FComando); - Writeln(FComando, comando); - finally - CloseFile(FComando); - end; - if length(trim(comando)) > 30 then begin vPrinter := TPrinter.Create; @@ -260,7 +246,7 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: end else begin - if Trim(UpperCase(Printer.Printers[I])) = Trim(UpperCase(copy(Impressora, 1, POS('(', Impressora)-1))) then + if Trim(UpperCase(Printer.Printers[I])) = Trim(UpperCase(Impressora)) then begin vPrinter.PrinterIndex := I; break; @@ -283,28 +269,6 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: FreeAndNil(vPrinter); end; end; - - /////////Dessa forma será gerado um arquivo txt e um BAT e o bat executa a impressao, mas apenas para impressoras compartilhadas - /// - /// - //_erroType := diretorio + '\errotype.txt'; - //_erroPrint := diretorio + '\erroprint.txt'; - - {AssignFile(FBat, diretorio + 'PRINTLBL.BAT'); - try - Rewrite(FBat); - Writeln(FBat, Format('(TYPE "%s\COMANDO.TXT" >"%s" 2>%s ) 2>%s',[diretorio, impressora, _erroType, _erroPrint])); - finally - CloseFile(FBat); - end;} - - //SysUtils.DeleteFile(_erroType); - //SysUtils.DeleteFile(_erroPrint); - - //ShellExecute(0, nil, PWideChar(diretorio + 'PRINTLBL.BAT'), '', nil, SW_HIDE); - - //erro := UtilsUnit.LoadFromFile(_erroType); - //erro := erro + StrUtils.IfThen(erro.IsEmpty, #13#10) + UtilsUnit.LoadFromFile(_erroPrint); except end; @@ -878,3 +842,4 @@ function LocalIp: string; end. + From 19496b6200f7a82fe1920c01bedb11fedece29e4 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 10 Jul 2019 15:42:43 -0300 Subject: [PATCH 209/294] correcao de merge --- Lib/UtilsUnitGUI.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 48148c5..207cb25 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -62,7 +62,7 @@ function LocalIp: string; implementation -uses IdIPWatch, IdTCPClient; +uses IdIPWatch, IdTCPClient, WinSpool; procedure setHabilitaButton(btn: TButton; enabled: boolean); begin From 16874a34a55c0d9f20b1b4fd67d68ab7fc58dd3e Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 6 Aug 2019 09:40:53 -0300 Subject: [PATCH 210/294] removendo warnings --- Lib/UtilsUnitGUI.pas | 6 ++---- Report/acCustomReportUn.pas | 1 + 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 71c72f5..1edeecb 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -219,9 +219,7 @@ procedure setHabilitaEdit(edit: TEdit; enabled: boolean); procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: string); var - FBat, FComando: TextFile; - diretorio: string; - cmm, printerName: AnsiString; + cmm: AnsiString; I: Integer; vPrinter : TPrinter; begin @@ -252,7 +250,7 @@ procedure ImprimirImpressoraTermica(const comando, impressora: String; var erro: //É necessário inicializar o comando com "N" para limpar as configurações da impressora caso ela tenha imprimido algum outro padrão de etiqueta. //é necessário que haja 2 "N" logo no começo do comando; - cmm := 'N' + #10 + Trim(comando)+#10 + 'N' + #10; + cmm := AnsiString('N' + #10 + Trim(comando)+#10 + 'N' + #10); StartDocPrinter(vPrinter.Handle, 1, @cmm); vPrinter.BeginDoc; diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 60c6d33..475a03d 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -158,6 +158,7 @@ procedure TacCustomReport.Print(const PID: integer); config.preview := true; try encontrou := false; + idTemplate := 0; if acCustomRelatorioData.isChangeable(ClassName) then begin idTemplate := acCustomRelatorioData.getTemplateConfigForUser(ClassName, config); From 83ce201f8706989c26a9b10ba90108b618ced370 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 4 Sep 2019 10:37:58 -0300 Subject: [PATCH 211/294] voltando os metodos ValidaTravamento e ProcessExists --- Lib/UtilsUnitGUI.pas | 53 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 1edeecb..a6067da 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -55,6 +55,8 @@ function Execute(const aCommando: string; const ShowWindow: boolean; var aProces procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); procedure CloseProcess(const aProcessInformation: TProcessInformation); function LocalIp: string; +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; implementation @@ -781,6 +783,57 @@ function LocalIp: string; end; end; +function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; +var + dwResult: PDWORD_PTR; + ValorRetorno: Longint; + AppHandle : THandle; +begin + Result := False; + + try + AppHandle:= UtilsUnitGui.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + if AppHandle <> 0 then + begin + ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, + SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); + if ValorRetorno > 0 then + Result := True + else + Result := False; + end; + except + end; +end; + +function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; + var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; +var + ContinueLoop: BOOL; + FSnapshotHandle: THandle; + FProcessEntry32: TProcessEntry32; +begin + FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + try + FProcessEntry32.dwSize := SizeOf(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + Result := False; + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = + UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = + UpperCase(ExeFileName))) then + begin + Result := True; + ValidaTravamento(UpperCase(ExeFileName), FTaskName, FPid, FProcessa, FHWND, iListOfProcess); + end; + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + finally + CloseHandle(FSnapshotHandle); + end; +end; end. From a6ab5fbf571c40a99a2a4f9d5095cadf73e91278 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 4 Sep 2019 11:36:58 -0300 Subject: [PATCH 212/294] Removendo warnings --- Lib/UtilsUnitGUI.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index a6067da..914c099 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -791,7 +791,7 @@ function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FP AppHandle : THandle; begin Result := False; - + dwResult := nil; try AppHandle:= UtilsUnitGui.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); if AppHandle <> 0 then From cbf2f0ceb1056b2093c4fa8bd3d8f2efe76abf9a Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 8 Oct 2019 15:12:32 -0300 Subject: [PATCH 213/294] ticket_id: #82068 - alterando funcao getIdadeDias para melhoria do calculo de valor de referencia, considerando a quantidade de dias entre as datas de uma forma mais parecida com o calendario, ao inves de predefinir a quantidade de dias como fator de multiplicacao --- Lib/osReportUtils.pas | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 9e08b53..eb75104 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -603,18 +603,16 @@ function TIdade.getString: string; function getIdadeDias(idade: string): integer; var tipoIdade: String; - original, fatorMult: integer; + original: integer; begin idade := trim(idade); tipoIdade := idade[length(idade)]; - fatorMult := 1; + original := StrToInt(copy(idade, 1, length(idade)-1)); case tipoIdade[1] of - 'd': fatorMult := 1; - 'm': fatorMult := 30; - 'a': fatorMult := 365; + 'd': result := DaysBetween(acCustomSQLMainData.GetServerDate, IncDay(Now, original) * -1); + 'm': result := DaysBetween(acCustomSQLMainData.GetServerDate, INCMONTH(Now, original) * -1); + 'a': result := DaysBetween(acCustomSQLMainData.GetServerDate, IncYear(Now, original) * -1); end; - original := StrToInt(copy(idade, 1, length(idade)-1)); - result := original * fatorMult; end; procedure replaceReportSQLAddParam(report: TppReport; template: TMemoryStream; From 9f543b7d23327cf6fd4b83b68875aff6c2c15575 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 8 Oct 2019 15:19:14 -0300 Subject: [PATCH 214/294] ticket_id: #82068 - alterando funcao getIdadeDias para melhoria do calculo de valor de referencia, considerando a quantidade de dias entre as datas de uma forma mais parecida com o calendario, ao inves de predefinir a quantidade de dias como fator de multiplicacao (removendo warning) --- Lib/osReportUtils.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index eb75104..ea71f23 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -605,6 +605,7 @@ function getIdadeDias(idade: string): integer; tipoIdade: String; original: integer; begin + result := 0; idade := trim(idade); tipoIdade := idade[length(idade)]; original := StrToInt(copy(idade, 1, length(idade)-1)); From 37b910363f4ea6f1ee1cbbdb9d4d35459b1e9be6 Mon Sep 17 00:00:00 2001 From: Guilherme Date: Wed, 9 Oct 2019 11:02:58 -0300 Subject: [PATCH 215/294] ticket_id: #82068 - alterando funcao getIdadeDias para melhoria do calculo de valor de referencia, considerando a quantidade de dias entre as datas de uma forma mais parecida com o calendario, ao inves de predefinir a quantidade de dias como fator de multiplicacao. --- Lib/osReportUtils.pas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index ea71f23..f07686c 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -604,15 +604,17 @@ function getIdadeDias(idade: string): integer; var tipoIdade: String; original: integer; + data: TDateTime; begin result := 0; idade := trim(idade); tipoIdade := idade[length(idade)]; original := StrToInt(copy(idade, 1, length(idade)-1)); + data := acCustomSQLMainData.GetServerDate; case tipoIdade[1] of - 'd': result := DaysBetween(acCustomSQLMainData.GetServerDate, IncDay(Now, original) * -1); - 'm': result := DaysBetween(acCustomSQLMainData.GetServerDate, INCMONTH(Now, original) * -1); - 'a': result := DaysBetween(acCustomSQLMainData.GetServerDate, IncYear(Now, original) * -1); + 'd': result := DaysBetween(data, IncDay(data, original * -1)); + 'm': result := DaysBetween(data, INCMONTH(data, original * -1)); + 'a': result := DaysBetween(data, IncYear(data, original * -1)); end; end; From 5601e3a70755415c8202e76e9aae6c667ecf8baa Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 14 Oct 2019 15:23:09 -0300 Subject: [PATCH 216/294] ticket_id: #83200 adicionando funcao para verificar se o arquivo esta aberto --- Lib/UtilsUnit.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 7cba375..2fa7a11 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -132,6 +132,7 @@ function MappJsonToDict(const aJsonString: string) : TJsonArray; function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringList; procedure SaveToFile(const aFilename, aContent: string); function LoadFromFile(const aFileName: string): string; +Function FileIsOpen(const FileName : TFileName) : Boolean; implementation @@ -2104,5 +2105,16 @@ function LoadFromFile(const aFileName: string): string; end; end; +Function FileIsOpen(const FileName : TFileName) : Boolean; +begin + Result := False; + try + With TFileStream.Create( FileName, fmOpenread or fmShareExclusive) + do Free; + except + Result := True; + end; +end; + end. From 1a0e8fab3951e413e880c8e1114bf6b69a755d7a Mon Sep 17 00:00:00 2001 From: Guilherme Date: Mon, 28 Oct 2019 15:33:12 -0300 Subject: [PATCH 217/294] =?UTF-8?q?ticket=5Fid:=20#82069=20-=20Padroniza?= =?UTF-8?q?=C3=A7=C3=A3o=20da=20abertura=20dos=20recursos=20de=20BI,=20Cen?= =?UTF-8?q?tral=20de=20Compras,=20StockFin.=20Ajuste=20tambem=20para=20apl?= =?UTF-8?q?icar=20o=20Proxy=20corretamente.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 50 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 2fa7a11..cbaa214 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -133,6 +133,7 @@ function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringLis procedure SaveToFile(const aFilename, aContent: string); function LoadFromFile(const aFileName: string): string; Function FileIsOpen(const FileName : TFileName) : Boolean; +procedure UpdateProxy(var dir: string); implementation @@ -2116,5 +2117,54 @@ function LoadFromFile(const aFileName: string): string; end; end; +procedure UpdateProxy(var dir: string); +var + configFileName, porta, proxy: string; + configFile: TStringList; + i: integer; +begin + proxy := ParametroSistemaData.MasterClientDatasetENDERECOPROXY.asString; + porta := ParametroSistemaData.MasterClientDatasetPORTAPROXY.asString; + + if (proxy <> '') and (porta <> '') then + begin + configFile := TStringList.Create; + configFileName := dir + '\prefs.js'; + + configFile.LoadFromFile(configFileName); + i := 0; + while (i < configFile.Count) do + begin + if (pos('user_pref("network.cookie.prefsMigrated', configFile.strings[i]) > 0) + or (pos('user_pref("network.predictor.cleaned-up', configFile.strings[i]) > 0) + or (pos('user_pref("network.proxy', configFile.strings[i]) > 0) then + configFile.Delete(i) + else + Inc(i); + end; + + configFile.add('user_pref("network.cookie.prefsMigrated", true);'); + configFile.add('user_pref("network.predictor.cleaned-up", true);'); + configFile.add('user_pref("network.proxy.backup.ftp", "");'); + configFile.add('user_pref("network.proxy.backup.ftp_port", 0);'); + configFile.add('user_pref("network.proxy.backup.socks", "");'); + configFile.add('user_pref("network.proxy.backup.socks_port", 0);'); + configFile.add('user_pref("network.proxy.backup.ssl", "");'); + configFile.add('user_pref("network.proxy.backup.ssl_port", 0);'); + configFile.add('user_pref("network.proxy.ftp", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.ftp_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.http", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.http_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.share_proxy_settings", true);'); + configFile.add('user_pref("network.proxy.socks", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.socks_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.ssl", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.ssl_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.type", 1);'); + + configFile.SaveToFile(configFileName); + end; +end; + end. From 3990d5b99f81c789891ec863146d4820fd79bd5f Mon Sep 17 00:00:00 2001 From: Guilherme Date: Mon, 28 Oct 2019 16:46:25 -0300 Subject: [PATCH 218/294] =?UTF-8?q?ticket=5Fid:=20#82069=20-=20Padroniza?= =?UTF-8?q?=C3=A7=C3=A3o=20da=20abertura=20dos=20recursos=20de=20BI,=20Cen?= =?UTF-8?q?tral=20de=20Compras,=20StockFin.=20Ajuste=20tambem=20para=20apl?= =?UTF-8?q?icar=20o=20Proxy=20corretamente.=20Ajuste?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index cbaa214..520472b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -133,7 +133,7 @@ function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringLis procedure SaveToFile(const aFilename, aContent: string); function LoadFromFile(const aFileName: string): string; Function FileIsOpen(const FileName : TFileName) : Boolean; -procedure UpdateProxy(var dir: string); +procedure UpdateProxy(dir: string); implementation @@ -2117,7 +2117,7 @@ function LoadFromFile(const aFileName: string): string; end; end; -procedure UpdateProxy(var dir: string); +procedure UpdateProxy(dir: string); var configFileName, porta, proxy: string; configFile: TStringList; From 855228a6b15a5471b1d377441ff74ed695082fae Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 30 Oct 2019 10:20:01 -0300 Subject: [PATCH 219/294] merge --- Lib/UtilsUnit.pas | 62 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 7cba375..520472b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -132,6 +132,8 @@ function MappJsonToDict(const aJsonString: string) : TJsonArray; function GetListaCamposTabela(conn: TSQLConnection; pTabela: String): TStringList; procedure SaveToFile(const aFilename, aContent: string); function LoadFromFile(const aFileName: string): string; +Function FileIsOpen(const FileName : TFileName) : Boolean; +procedure UpdateProxy(dir: string); implementation @@ -2104,5 +2106,65 @@ function LoadFromFile(const aFileName: string): string; end; end; +Function FileIsOpen(const FileName : TFileName) : Boolean; +begin + Result := False; + try + With TFileStream.Create( FileName, fmOpenread or fmShareExclusive) + do Free; + except + Result := True; + end; +end; + +procedure UpdateProxy(dir: string); +var + configFileName, porta, proxy: string; + configFile: TStringList; + i: integer; +begin + proxy := ParametroSistemaData.MasterClientDatasetENDERECOPROXY.asString; + porta := ParametroSistemaData.MasterClientDatasetPORTAPROXY.asString; + + if (proxy <> '') and (porta <> '') then + begin + configFile := TStringList.Create; + configFileName := dir + '\prefs.js'; + + configFile.LoadFromFile(configFileName); + i := 0; + while (i < configFile.Count) do + begin + if (pos('user_pref("network.cookie.prefsMigrated', configFile.strings[i]) > 0) + or (pos('user_pref("network.predictor.cleaned-up', configFile.strings[i]) > 0) + or (pos('user_pref("network.proxy', configFile.strings[i]) > 0) then + configFile.Delete(i) + else + Inc(i); + end; + + configFile.add('user_pref("network.cookie.prefsMigrated", true);'); + configFile.add('user_pref("network.predictor.cleaned-up", true);'); + configFile.add('user_pref("network.proxy.backup.ftp", "");'); + configFile.add('user_pref("network.proxy.backup.ftp_port", 0);'); + configFile.add('user_pref("network.proxy.backup.socks", "");'); + configFile.add('user_pref("network.proxy.backup.socks_port", 0);'); + configFile.add('user_pref("network.proxy.backup.ssl", "");'); + configFile.add('user_pref("network.proxy.backup.ssl_port", 0);'); + configFile.add('user_pref("network.proxy.ftp", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.ftp_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.http", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.http_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.share_proxy_settings", true);'); + configFile.add('user_pref("network.proxy.socks", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.socks_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.ssl", "' + proxy + '");'); + configFile.add('user_pref("network.proxy.ssl_port", ' + porta + ');'); + configFile.add('user_pref("network.proxy.type", 1);'); + + configFile.SaveToFile(configFileName); + end; +end; + end. From d1c9f60515a14b3c0ffa66308ab4fc3f52a5a4fc Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 11 Dec 2019 11:51:03 -0300 Subject: [PATCH 220/294] ticket_id: #84677 - melhoria no ListFileDir, permitindo usar diferentes extensoes de arquivo --- Lib/UtilsUnit.pas | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 520472b..f6c3f49 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -32,7 +32,7 @@ function getSombraValue(Str:String): String; function TiraSimbolos(Str: String): String; function LastDayOfMonth(dia: TDate = 0): TDate; function roundToCurr(val: double): double; -procedure ListFileDir(Path: string; FileList: TStrings); +procedure ListFileDir(Path: string; FileList: TStrings; pExtensao: string = 'xml'); function isNumeric(valor: string; acceptThousandSeparator: Boolean = False): boolean; function isIP(valor: string): boolean; function isConvert(Str: string): boolean; @@ -134,6 +134,7 @@ procedure SaveToFile(const aFilename, aContent: string); function LoadFromFile(const aFileName: string): string; Function FileIsOpen(const FileName : TFileName) : Boolean; procedure UpdateProxy(dir: string); +procedure RemoveDiretorio(Dir: String); implementation @@ -184,11 +185,11 @@ function ConverteDataHora(data: string): TDateTime; Copy(data,9,2)+':'+Copy(data,11,2)+':'+Copy(data,13,2)); end; -procedure ListFileDir(Path: string; FileList: TStrings); +procedure ListFileDir(Path: string; FileList: TStrings; pExtensao: string = 'xml'); var SR: TSearchRec; begin - if FindFirst(Path + '\*.xml', faAnyFile, SR) = 0 then + if FindFirst(Path + '\*.'+pExtensao, faAnyFile, SR) = 0 then begin repeat if (SR.Attr <> faDirectory) then @@ -2166,5 +2167,19 @@ procedure UpdateProxy(dir: string); end; end; +procedure RemoveDiretorio(Dir: String); +var + Result: TSearchRec; Found: Boolean; +begin + Found := False; + if FindFirst(Dir + '\*', faAnyFile, Result) = 0 then + while not Found do begin + if (Result.Attr and faDirectory = faDirectory) AND (Result.Name <> '.') AND (Result.Name <> '..') then RemoveDiretorio(Dir + '\' + Result.Name) + else if (Result.Attr and faAnyFile <> faDirectory) then DeleteFile(Dir + '\' + Result.Name); + Found := FindNext(Result) <> 0; + end; + FindClose(Result); RemoveDir(Dir); +end; + end. From 346270e7fb74cfe0c4adddf5df005e25d37077d5 Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 18 Dec 2019 16:47:47 -0200 Subject: [PATCH 221/294] =?UTF-8?q?Ticket=5FID:=20#85350=20-=20Corre=C3=A7?= =?UTF-8?q?=C3=A3o=20para=20n=C3=A3o=20dar=20erro=20quando=20tenta=20calcu?= =?UTF-8?q?lar=20valor=20de=20referencia=20pelo=20interfaceamento?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.pas | 6 +++--- Lib/osReportUtils.pas | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 202b5c6..5cc7117 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -78,7 +78,7 @@ TacCustomSQLMainData = class(TDataModule) function GetQuery(meta: boolean = false): TosSQLQuery; procedure FreeQuery(Query: TosSQLQuery); - function GetServerDate: TDatetime; + function GetServerDate(aConnection: TSQLConnection=nil): TDatetime; function GetServerDatetime(aConnection: TSQLConnection=nil): TDatetime; function InTransaction: boolean; function StartTransaction: TDBXTransaction; @@ -439,9 +439,9 @@ function TacCustomSQLMainData.GetNewID(nomeGenerator: String= ''; aConnection: T end; end; -function TacCustomSQLMainData.GetServerDate: TDatetime; +function TacCustomSQLMainData.GetServerDate(aConnection: TSQLConnection=nil): TDatetime; begin - Result := StrToDatetime(FormatDatetime('dd/mm/yyyy', GetServerDatetime)); + Result := StrToDatetime(FormatDatetime('dd/mm/yyyy', GetServerDatetime(aConnection))); end; function TacCustomSQLMainData.GetServerDatetime(aConnection: TSQLConnection=nil): TDatetime; diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index f07686c..9519908 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -28,7 +28,7 @@ type TIdade = class end; - function getIdadeDias(idade: string): integer; + function getIdadeDias(idade: string; conn: TSQLConnection = nil): integer; function getTemplateByName(name: string; stream: TMemoryStream): boolean; function getTemplateByID(id: integer; stream: TMemoryStream): boolean; function getTemplateIDByName(name: string): integer; @@ -600,7 +600,7 @@ function TIdade.getString: string; result:= '0 dia'; end; -function getIdadeDias(idade: string): integer; +function getIdadeDias(idade: string; conn: TSQLConnection = nil): integer; var tipoIdade: String; original: integer; @@ -610,7 +610,7 @@ function getIdadeDias(idade: string): integer; idade := trim(idade); tipoIdade := idade[length(idade)]; original := StrToInt(copy(idade, 1, length(idade)-1)); - data := acCustomSQLMainData.GetServerDate; + data := acCustomSQLMainData.GetServerDate(conn); case tipoIdade[1] of 'd': result := DaysBetween(data, IncDay(data, original * -1)); 'm': result := DaysBetween(data, INCMONTH(data, original * -1)); From 29ac67c2bc9f0a3cb778693e389cb3a515aa7b1f Mon Sep 17 00:00:00 2001 From: Guilherme Date: Thu, 9 Jan 2020 17:41:12 -0300 Subject: [PATCH 222/294] =?UTF-8?q?Ticket=5FID:=20#73714=20-=20Corre=C3=A7?= =?UTF-8?q?=C3=A3o.=20Nao=20estava=20encontrando=20ID=20do=20template=20pa?= =?UTF-8?q?ra=20quando=20laudo=20publica=C3=A7=C3=A3o.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Report/acCustomReportUn.pas | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 475a03d..1fd0b4b 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -25,6 +25,7 @@ TConfigImpressao = record margemEsquerda: double; margemDireita: double; tipoSaida: string; + IDTemplate: integer; end; TAdendo = record @@ -152,10 +153,12 @@ procedure TacCustomReport.Print(const PID: integer); config.margemInferior := -1; config.margemEsquerda := -1; config.margemDireita := -1; + config.IDTemplate := -1; config.tipoSaida := TSTela; beforePrint := Report.BeforePrint; stream := TMemoryStream.Create; config.preview := true; + try encontrou := false; idTemplate := 0; @@ -325,6 +328,9 @@ procedure TacCustomReport.Print(const PID: integer); Report.Print; updateContadorImpressao := MainData.GetQuery; try + if idTemplate = 0 then + idTemplate := config.IDTemplate; + updateContadorImpressao.SQL.Text := 'UPDATE rb_item '+ ' SET FREQUENCIAUSO = FREQUENCIAUSO+1, '+ ' DATAULTIMAIMPRESSAO = ' From 011940ef46d4b93f3f27b3aed4f8975573142caf Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 13 Jan 2020 09:37:58 -0300 Subject: [PATCH 223/294] Adicionando o extractbetween as funcoes --- Lib/UtilsUnit.pas | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index f6c3f49..39b3848 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -135,6 +135,7 @@ function LoadFromFile(const aFileName: string): string; Function FileIsOpen(const FileName : TFileName) : Boolean; procedure UpdateProxy(dir: string); procedure RemoveDiretorio(Dir: String); +function ExtractBetween(const Value, A, B: string): string; implementation @@ -2181,5 +2182,20 @@ procedure RemoveDiretorio(Dir: String); FindClose(Result); RemoveDir(Dir); end; +function ExtractBetween(const Value, A, B: string): string; +var + aPos, bPos: Integer; +begin + result := ''; + aPos := Pos(A, Value); + if aPos > 0 then begin + aPos := aPos + Length(A); + bPos := PosEx(B, Value, aPos); + if bPos > 0 then begin + result := Copy(Value, aPos, bPos - aPos); + end; + end; +end; + end. From c84e830f14c73b8af99743653622f166414e0d25 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 12 Mar 2020 08:19:53 -0300 Subject: [PATCH 224/294] ticket_id: #87759 - recoleta, clonardataset --- Lib/UtilsUnit.pas | 63 ++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 62 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 39b3848..b2cb129 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -70,7 +70,8 @@ function ValueIsEmptyNull(aValue : Variant):Boolean; function getDescricaoSexo(const vValor : Variant):String; function getDescricaoSimNao(const vValor : Variant):String; function getDescricaoTipoResultado(const vValor : Variant):String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); overload; +procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDataSet); overload; function FormataStringList(texto, delimitador: string): string; function ApenasNumeros(const valor : String) : String; function ApenasLetrasNumeros(nStr:String): String; @@ -1004,6 +1005,14 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien field := TMemoField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TIntegerField then field := TIntegerField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TDateTimeField then + field := TDateTimeField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TDateField then + field := TDateField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TSQLTimeStampField then + field := TSQLTimeStampField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TFloatField then + field := TFloatField.Create(cdsDestino) else field := TStringField.Create(cdsDestino); @@ -1035,6 +1044,58 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien end; end; +procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDataSet); +var + field : TField; + i: Integer; + Parametro: TParam; +begin + if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then + begin + for i := 0 to cdsOrigem.FieldCount-1 do + begin + if (cdsOrigem.Fields[i]) is TMemoField then + field := TMemoField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TIntegerField then + field := TIntegerField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TDateTimeField then + field := TDateTimeField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TDateField then + field := TDateField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TSQLTimeStampField then + field := TSQLTimeStampField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TFloatField then + field := TFloatField.Create(cdsDestino) + else + field := TStringField.Create(cdsDestino); + + Field.FieldKind := fkData; + Field.FieldName := cdsOrigem.Fields[i].FieldName; + Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; + Field.Visible := cdsOrigem.Fields[i].Visible; + if (cdsOrigem.Fields[i] is TStringField) then + Field.Size := cdsOrigem.Fields[i].Size; + Field.DataSet := cdsDestino; + + end; + cdsDestino.Close; + cdsDestino.CreateDataSet; + end; + + cdsOrigem.First; + while not cdsOrigem.Eof do + begin + cdsDestino.Append; + for i := 0 to cdsOrigem.FieldCount-1 do + begin + if not cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).IsNull then + cdsDestino.FieldByName(cdsDestino.Fields[i].FieldName).AsString := cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).AsString; + end; + cdsDestino.Post; + cdsOrigem.Next; + end; +end; + function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; begin Result := Trim(Valor); From 63f6e1e229a657e0038b723510fe669c0fe78179 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 13 Mar 2020 11:38:13 -0300 Subject: [PATCH 225/294] removendo hint --- Lib/UtilsUnit.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index b2cb129..382e206 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1048,7 +1048,6 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa var field : TField; i: Integer; - Parametro: TParam; begin if cdsOrigem.Fields.Count <> cdsDestino.Fields.Count then begin From cee6acb580a0ce20f0fa61e67b51389df790756f Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 23 Apr 2020 10:06:36 -0300 Subject: [PATCH 226/294] ticket_id: #88995 - Alteracao necessaria para que o agendador tenha acesso ao SqlMainData e tambem a geracao de laudos usando o Report --- Datamodules/acCustomSQLMainDataUn.pas | 12 +++-- Lib/osReportUtils.pas | 75 ++++++++++++++++----------- 2 files changed, 54 insertions(+), 33 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 5cc7117..75b23e0 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -188,8 +188,8 @@ constructor TacCustomSQLMainData.Create(AOwner: TComponent);  ------------------------------------------------------------------------} constructor TacCustomSQLMainData.CreateOwn(AOwner: TComponent; bd: string); begin - Self.Create(AOwner); self.BD := bd; + Self.Create(AOwner); end; {------------------------------------------------------------------------- @@ -333,8 +333,10 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); with TStringList.Create do begin try - if bd='' then + if self.BD = '' then LoadFromFile(selectParamsFileName) + else if self.BD <> '' then //Atualmente usado pela ClimepeAgendador.dll, na unit BaseDLLUn é chamado o CreateOwn + LoadFromFile(bd) else begin add('BlobSize=-1'); @@ -541,7 +543,11 @@ procedure TacCustomSQLMainData.RegisterRefreshTable(PTableName: string; else RefreshTable.FDataset := PDataSet; - PDataSet.Open; + Try + PDataSet.Open; + Except + + End; end; diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 9519908..78e88a8 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -202,43 +202,58 @@ function getTemplateById(id: integer; stream: TMemoryStream): boolean; query: TosSQLDataset; report: string; ss: TStringStream; + ComponenteRelatorio: TacReportContainer; begin Result := false; - report := TacReportContainer(Application.MainForm.FindComponent('FReportDepot')). - findReportById(id); - if Length(report) > 0 then - begin - try - ss := TStringStream.Create(report); - stream.LoadFromStream(ss); - Result := True; - finally - FreeAndNil(ss); - end; - end + if Application.MainForm <> nil then + report := TacReportContainer(Application.MainForm.FindComponent('FReportDepot')).findReportById(id) else begin - query := TosSQLDataSet.Create(nil); - try - query.SQLConnection := acCustomSQLMainData.SQLConnection; - query.CommandText := ' SELECT ' + - ' template, '+ - ' name '+ - ' FROM ' + - ' RB_ITEM '+ - ' WHERE ' + - ' ITEM_ID = ' + intToStr(id); - query.Open; - if query.RecordCount>0 then - begin - TBLOBField(query.fields[0]).SaveToStream(stream); - TacReportContainer(Application.MainForm.FindComponent('FReportDepot')). - addReport(id, query.fields[1].AsString, query.fields[0].AsString); + //Dessa forma o agendador pode ter acesso ao componente de relatório + ComponenteRelatorio := TacReportContainer.Create(nil); + report := ComponenteRelatorio.findReportById(id); + end; + + try + if Length(report) > 0 then + begin + try + ss := TStringStream.Create(report); + stream.LoadFromStream(ss); Result := True; + finally + FreeAndNil(ss); + end; + end + else + begin + query := TosSQLDataSet.Create(nil); + try + query.SQLConnection := acCustomSQLMainData.SQLConnection; + query.CommandText := ' SELECT ' + + ' template, '+ + ' name '+ + ' FROM ' + + ' RB_ITEM '+ + ' WHERE ' + + ' ITEM_ID = ' + intToStr(id); + query.Open; + if query.RecordCount>0 then + begin + TBLOBField(query.fields[0]).SaveToStream(stream); + if Application.MainForm <> nil then + TacReportContainer(Application.MainForm.FindComponent('FReportDepot')).addReport(id, query.fields[1].AsString, query.fields[0].AsString) + else + ComponenteRelatorio.addReport(id, query.fields[1].AsString, query.fields[0].AsString); + Result := True; + end; + finally + FreeAndNil(query); end; - finally - FreeAndNil(query); end; + finally + if Application.MainForm = nil then + FreeAndNil(ComponenteRelatorio); end; end; From 4e157f19bc7f095c6b69c33092f909b59a43544b Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 27 Apr 2020 16:29:23 -0300 Subject: [PATCH 227/294] ticket_id: #89170 - Refatotando o metodo "NomeDaTecla" pois estava retornando "?" em alguns computadores --- Lib/UtilsUnit.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 382e206..52b2d5e 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -596,6 +596,7 @@ function NomeDaTecla(Key: Word): string; keyboardState: TKeyboardState; asciiResult: Integer; begin + Result := ''; case Key of VK_BACK: Result := '[BACKSPACE]'; //backspace VK_RETURN: Result := '[ENTER]'; //enter @@ -649,7 +650,8 @@ function NomeDaTecla(Key: Word): string; 222: Result := '~'; //~ acento else GetKeyboardState(keyboardState); - SetLength(Result, 10) ; + Result := EspacoDireita(Result,10); +// SetLength(Result, 10) ; //Se usar o SetLength em alguns casos o valor é inicializado com caracter estranho asciiResult := ToAscii(key, MapVirtualKey(key, 0), keyboardState, @Result[1], 0) ; case asciiResult of 0: Result := ''; From 9d2e519911858d7cd364d2f4bb91c4628cba300b Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 14 May 2020 14:43:32 -0300 Subject: [PATCH 228/294] ticket_id: #89426 - Adicionando SLL ao componente HTTP --- Lib/UtilsUnit.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 52b2d5e..5cfedba 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1408,9 +1408,14 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon function Fallback: Boolean; var _FHttp: TIdHTTP; + _FLHandler: TIdSSLIOHandlerSocketOpenSSL; begin _FHttp := TIdHTTP.Create(AOwner); + _FLHandler := TIdSSLIOHandlerSocketOpenSSL.Create(_FHttp); try + _FHttp.AllowCookies := True; + _FHttp.IOHandler := _FLHandler; + _FHttp.HandleRedirects := True; Result := TestConnection(address); try if stream is TIdMultiPartFormDataStream then @@ -1426,6 +1431,7 @@ function getUriUrlStatus(const address: String; stream: TStream; AOwner: TCompon end; finally FreeAndNil(_FHttp); + FreeAndNil(_FLHandler); end; end; begin @@ -1931,6 +1937,8 @@ function GetPageAsString(const url: String): String; lUri := TIdUri.Create; try lHTTP.IOHandler := IOHandler; + lHTTP.HandleRedirects := True; + lHTTP.AllowCookies := True; Result := lHTTP.Get(lUri.URLEncode(url)); finally FreeAndNil(IOHandler); From 8660f69fcc9481863a37feeaf4a9927794a68501 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 20 May 2020 10:24:16 -0300 Subject: [PATCH 229/294] ticket_id: #89676 - Adicionando log de alteracao e inclusao de medico --- Lib/UtilsUnitGUI.pas | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 914c099..5702d23 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -42,6 +42,7 @@ function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS const sCampoChave: String; aCampoDescricao: Array of String): String; function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; AlteradoCDS: TClientDataSet; const sCampoChave: String; aCampoDescricao: Array of String; const sDescricao : String ): String; +function CriarMsgLogCDSNovoRegistro(pCDS: TClientDataSet) : String; function isRTFValue(vValor: Variant): Boolean; //{\rtf procedure TrimAppMemorySize; function dgCreateProcess(const FileName: string; SleepInterval: integer = 10000): boolean; @@ -340,7 +341,7 @@ function getCampoSemRTF(const vValor : Variant):String; function CriarMsgLogAlteracaoField(aField : TField):String; overload; begin Result := EmptyStr; - if (aField.FieldKind <> fkLookup) and (FieldHasChanged(aField)) then + if (aField.FieldKind <> fkLookup) and (aField.DataType <> ftDataSet) and (FieldHasChanged(aField)) then Result := Format(sMODELOMSGLOG,[aField.DisplayLabel, getCampoSemRTF(aField.OldValue), getCampoSemRTF(aField.NewValue)]); end; @@ -489,6 +490,23 @@ function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; Alter end; end; +function CriarMsgLogCDSNovoRegistro(pCDS: TClientDataSet) : String; +var + I: Integer; + msg: String; +begin + Result := EmptyStr; + pCDS.First; + msg := ''; + for I := 0 to pCDS.FieldCount-1 do + begin + if (pCDS.Fields[I].FieldKind = fkData) and (pCDS.Fields[I].DataType <> ftBlob) and (pCDS.Fields[I].DataType <> ftMemo) and + (pCDS.Fields[I].DataType <> ftDataSet) then + msg := msg + pCDS.Fields[I].DisplayLabel + ' : ' + pCDS.Fields[I].AsString + #13#10; + end; + Result := msg; +end; + function isRTFValue(vValor: Variant): Boolean; begin Result := False; From 7d98bc31343945243f20765c3cf10312de643f69 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 31 Aug 2020 09:08:11 -0300 Subject: [PATCH 230/294] ticket_id: #91945 - melhorando metodo de busca de IP --- Lib/UtilsUnit.pas | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 5cfedba..acff62c 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -808,24 +808,29 @@ function ConverteStrToDate4(data: string): TDateTime; end; function GetIPAddress: string; +type pu_long = ^u_long; var - Buffer: array[0..255] of AnsiChar; - RemoteHost: PHostEnt; - tempAddress: Integer; - BufferR: array[0..3] of Byte absolute tempAddress; + varTWSAData : TWSAData; + varPHostEnt : PHostEnt; + varTInAddr : TInAddr; + namebuf : Array[0..255] of ansichar; begin - Winsock.GetHostName(@Buffer, 255); - RemoteHost := Winsock.GetHostByName(Buffer); - if RemoteHost = nil then - begin - tempAddress := winsock.htonl($07000001); { 127.0.0.1 } - end - else - begin - tempAddress := longint(pointer(RemoteHost^.h_addr_list^)^); - tempAddress := Winsock.ntohl(tempAddress); + try + try + If WSAStartup($101,varTWSAData) <> 0 Then + Result := '' + Else Begin + gethostname(namebuf,sizeof(namebuf)); + varPHostEnt := gethostbyname(namebuf); + varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^); + Result := inet_ntoa(varTInAddr); + End; + except + Result := ''; + end; + finally + WSACleanup; end; - Result := Format('%d.%d.%d.%d', [BufferR[3], BufferR[2], BufferR[1], BufferR[0]]); end; Function GetCurrentIpList:TSTringList; From afb1ee6dd94a54fe54e788d6c5882835d0b82349 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 8 Sep 2020 12:10:49 -0300 Subject: [PATCH 231/294] melhoria no metodo de clonar dataset --- Lib/UtilsUnit.pas | 41 +++++++++++++++++++++++++++++++++++++---- 1 file changed, 37 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index acff62c..cbfdb32 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -70,7 +70,7 @@ function ValueIsEmptyNull(aValue : Variant):Boolean; function getDescricaoSexo(const vValor : Variant):String; function getDescricaoSimNao(const vValor : Variant):String; function getDescricaoTipoResultado(const vValor : Variant):String; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); overload; +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet; onlyData: Boolean = False); overload; procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDataSet); overload; function FormataStringList(texto, delimitador: string): string; function ApenasNumeros(const valor : String) : String; @@ -999,7 +999,7 @@ function getDescricaoTipoResultado(const vValor : Variant):String; end; end; -procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet); +procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClientDataSet; onlyData: Boolean = False); var field : TField; i: Integer; @@ -1008,6 +1008,9 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien begin for i := 0 to cdsOrigem.FieldCount-1 do begin + if (onlyData) and ((cdsOrigem.Fields[i]) is TDataSetField) then + continue; + if (cdsOrigem.Fields[i]) is TMemoField then field := TMemoField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TIntegerField then @@ -1020,6 +1023,36 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien field := TSQLTimeStampField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TFloatField then field := TFloatField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TObjectField then + field := TObjectField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TGraphicField then + field := TGraphicField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TWideMemoField then + field := TWideMemoField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TADTField then + field := TADTField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TArrayField then + field := TArrayField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TDataSetField then + field := TDataSetField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TReferenceField then + field := TReferenceField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TVariantField then + field := TVariantField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TAggregateField then + field := TAggregateField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TBlobField then + field := TBlobField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TFMTBCDField then + field := TFMTBCDField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TBCDField then + field := TBCDField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TTimeField then + field := TTimeField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TBooleanField then + field := TBooleanField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TCurrencyField then + field := TCurrencyField.Create(cdsDestino) else field := TStringField.Create(cdsDestino); @@ -1043,8 +1076,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien cdsDestino.Append; for i := 0 to cdsOrigem.FieldCount-1 do begin - if not cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).IsNull then - cdsDestino.FieldByName(cdsDestino.Fields[i].FieldName).AsString := cdsOrigem.FieldByName(cdsDestino.Fields[i].FieldName).AsString; + if (not cdsOrigem.Fields[i].IsNull) and (cdsDestino.FindField(cdsOrigem.Fields[i].FieldName) <> nil) then + cdsDestino.FieldByName(cdsOrigem.Fields[i].FieldName).AsString := cdsOrigem.FieldByName(cdsOrigem.Fields[i].FieldName).AsString; end; cdsDestino.Post; cdsOrigem.Next; From 608187647db7fb8bc5a7fc2e4b5a4c5f9a2b5967 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 30 Nov 2020 14:58:35 -0300 Subject: [PATCH 232/294] removendo warnings --- Lib/UtilsUnit.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index cbfdb32..926c2ea 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -823,7 +823,7 @@ function GetIPAddress: string; gethostname(namebuf,sizeof(namebuf)); varPHostEnt := gethostbyname(namebuf); varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^); - Result := inet_ntoa(varTInAddr); + Result := string(inet_ntoa(varTInAddr)); End; except Result := ''; From 1beb4a70822bdab55343f58443862482a219c8b0 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 5 May 2021 09:17:58 -0300 Subject: [PATCH 233/294] Adicionando EspacoEsquerda --- Lib/UtilsUnit.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 926c2ea..a369eb2 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -77,6 +77,7 @@ function ApenasNumeros(const valor : String) : String; function ApenasLetrasNumeros(nStr:String): String; function ZeraEsquerda(const Valor:String; const Tamanho:Integer): String; function EspacoDireita(Valor: String; const Tamanho: Integer): String; +function EspacoEsquerda(Valor: String; const Tamanho: Integer): String; function KeyToStr(Key:Word): String; function Base64FromBinary(const FileName: String): string; function Base64FromText(const text: String): string; @@ -1152,6 +1153,17 @@ function EspacoDireita(Valor: String; const Tamanho: Integer): String; Result := Valor + Result ; end; +function EspacoEsquerda(Valor: String; const Tamanho: Integer): String; +var + I : Integer ; +begin + Result := '' ; + Valor := Trim(Valor); + for I:=Length(Valor)+1 to Tamanho do + Result := ' ' + Result; + Result := Result + Valor ; +end; + function KeyToStr(Key:Word): String; var keyboardState: TKeyboardState; From 60e8e113c7dfca0978200ece429108cbb6e75647 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 28 May 2021 17:28:44 -0300 Subject: [PATCH 234/294] ticket_id: #98006 - registro de uso dos recursos e relatorios --- Forms/ImprimirRelatorioFormUn.dfm | 143 +----------------------- Forms/ImprimirRelatorioFormUn.pas | 174 +++++++++++++++--------------- Forms/osCustomMainFrm.dfm | 14 +-- Forms/osCustomMainFrm.pas | 11 +- Lib/osReportUtils.pas | 76 ++++++------- Report/acCustomReportUn.dfm | 2 +- Report/acCustomReportUn.pas | 11 +- 7 files changed, 153 insertions(+), 278 deletions(-) diff --git a/Forms/ImprimirRelatorioFormUn.dfm b/Forms/ImprimirRelatorioFormUn.dfm index e5b9437..e0ec8e5 100644 --- a/Forms/ImprimirRelatorioFormUn.dfm +++ b/Forms/ImprimirRelatorioFormUn.dfm @@ -1,5 +1,7 @@ inherited ImprimirRelatorioForm: TImprimirRelatorioForm Caption = 'ImprimirRelatorioForm' + ExplicitWidth = 320 + ExplicitHeight = 356 PixelsPerInch = 96 TextHeight = 13 object ComboFilter: TosComboFilter [1] @@ -25,147 +27,6 @@ inherited ImprimirRelatorioForm: TImprimirRelatorioForm inherited MasterDataSource: TDataSource DataSet = osClientDataset1 end - inherited ImageList: TImageList - Bitmap = { - 494C010101000400180010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 - 0000000000003600000028000000400000001000000001002000000000000010 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000C6C6BD00BDB5AD009C9C94008C84 - 84008C8484008C8484008C8484008C8484008C8484008C8484008C8484008C84 - 84008C84840094948C00B5ADA500000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000063312900633129006331 - 2900633129006331290063312900633129006331290063312900633129006331 - 2900633129007B73730094948C00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00AD847300DEB5A500DEB5 - A500D6ADA500D6AD9C00CEA59C00CE9C9400CE9C8C00C6948C00C6948400C694 - 84008C524200633129008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00B58C7B00FFF7F700FFF7 - F700F7EFEF00F7EFE700EFDED600DEC6B500DEBDAD00D6B5A500D6B5A500DEB5 - A5008C524200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00B58C7B00FFF7F700DEDE - D600DED6CE00DECEC600DECEBD00D6BDAD00CEB5A500CEAD9C00C6A59400DEBD - AD008C524200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00BD948400FFF7F700FFF7 - F700F7F7EF00F7EFEF00F7EFE700EFE7DE00E7D6CE00DEBDAD00D6BDAD00DEBD - B5008C524200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00BD9C8400FFF7F700FFF7 - F700FFF7F700F7F7EF00F7EFEF00F7EFE700EFE7DE00DEC6BD00DEC6B500E7CE - BD008C5A4200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00C69C8C00FFFFF700FFFF - F700FFF7F700FFF7F700F7F7EF00F7EFE700F7EFE700EFD6CE00EFD6C600E7D6 - C600945A4200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00C6A59400C6A59400C69C - 8C00BD948400BD948400BD947B00B58C7B00B5847300AD7B6B009C634A00945A - 4A00945A4A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00CEAD9C00C6A59400C6A5 - 9400BD9C8C00BD9C8400BD948400B58C7B00B58C7B00AD8473009C6352009C63 - 4A00945A4A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C635A00CEAD9C00CEAD9C00C6A5 - 9400C6A58C00BD9C8C00BD9C8400BD947B00B58C7B00B5847300AD7B6B009C63 - 5200945A4A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000008C6B5A00D6B5A500FFFFFF009C63 - 4A00D6BDAD00FFFFFF00FFFFFF00FFFFFF00FFFFF700FFEFEF00F7EFE700F7E7 - DE009C635200633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000946B5A00D6BDAD00FFFFFF009C63 - 4A00D6BDAD00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFF7F700FFF7EF00FFEF - EF00A56B5A00633121008C848400000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000946B5A00D6BDB500FFFFFF009C63 - 4A009C634A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFF700FFF7 - F700B58473006331290094948C00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000946B5A00946B5A008C6B - 5A008C635A008C635A008C635A008C6352008C6352008C6352008C6352008C5A - 5200845A5200BDBDB500CEC6BD00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000424D3E000000000000003E000000 - 2800000040000000100000000100010000000000800000000000000000000000 - 000000000000000000000000FFFFFF00FFFF0000000000000001000000000000 - 8001000000000000000100000000000000010000000000000001000000000000 - 0001000000000000000100000000000000010000000000000001000000000000 - 0001000000000000000100000000000000010000000000000001000000000000 - 0001000000000000800100000000000000000000000000000000000000000000 - 000000000000} - end object osClientDataset1: TosClientDataset Aggregates = <> FetchOnDemand = False diff --git a/Forms/ImprimirRelatorioFormUn.pas b/Forms/ImprimirRelatorioFormUn.pas index 9aa7011..8f76f0c 100644 --- a/Forms/ImprimirRelatorioFormUn.pas +++ b/Forms/ImprimirRelatorioFormUn.pas @@ -35,7 +35,7 @@ TImprimirRelatorioForm = class(TosCustomEditForm) implementation uses osReportUtils, acCustomSQLMainDataUn, osFrm, acCustomParametroSistemaDataUn, - acCustomReportUn, ReportUn; + acCustomReportUn, ReportUn, ParametroSistemaDataUn, StatusUnit; {$R *.dfm} @@ -74,6 +74,7 @@ procedure TImprimirRelatorioForm.ImprimirRelatorioComFiltro(idRelatorio: integer qry := acCustomSQLMainData.GetQuery; try qry.sql.Text := 'SELECT ' + + ' R.Titulo, '+ ' RB.Name as TemplateName, '+ ' F.Name as NomeFiltro, ' + ' R.ClasseImpressora, ' + @@ -83,6 +84,7 @@ procedure TImprimirRelatorioForm.ImprimirRelatorioComFiltro(idRelatorio: integer ' R.MargemDireita, ' + ' R.AlturaPapel, ' + ' R.LarguraPapel, ' + + ' R.Titulo, ' + ' R.Orientation, R.tipoSaida ' + ' FROM Relatorio R ' + ' LEFT JOIN XFilterDef F ' + @@ -110,100 +112,102 @@ procedure TImprimirRelatorioForm.ImprimirRelatorioComFiltro(idRelatorio: integer config.margemDireita := qry.fieldByName('margemDireita').AsInteger; if not qry.fieldByName('tipoSaida').IsNull then config.tipoSaida := qry.fieldByName('tipoSaida').AsString; - finally - acCustomSQLMainData.FreeQuery(qry); - end; - stream := TMemoryStream.Create; - getTemplateByName(TemplateName, stream); - if FilterName <> '' then - begin - ComboFilter.ClearViews; - ComboFilter.FilterDefName := FilterName; - ComboFilter.GetViews(); + config.NomeRelatorio := TemplateName; + stream := TMemoryStream.Create; + getTemplateByName(TemplateName, stream); - srchForm := TCustomSearchForm.Create(application); - with srchForm do + if FilterName <> '' then begin - FilterDefName := filterName; - srchForm.DataProvider := acCustomSQLMainData.prvFilter; - Execute('',3,toRetornarQuery); - where := GetExpressions; - order := getOrder; + ComboFilter.ClearViews; + ComboFilter.FilterDefName := FilterName; + ComboFilter.GetViews(); - if ConsultaCombo.GetExprList(ConsultaCombo.Items.IndexOf(ConsultaCombo.Text)).Text <> '' then + srchForm := TCustomSearchForm.Create(application); + with srchForm do begin - if where = '' then - where := ConsultaCombo.GetExprList(ConsultaCombo.Items.IndexOf(ConsultaCombo.Text)).Text - else - where := where + ' AND ' + - ConsultaCombo.GetExprList(ConsultaCombo.Items.IndexOf(ConsultaCombo.Text)).Text; - + FilterDefName := filterName; + srchForm.DataProvider := acCustomSQLMainData.prvFilter; + Execute('',3,toRetornarQuery); + where := GetExpressions; + order := getOrder; + + if ConsultaCombo.GetExprList(ConsultaCombo.Items.IndexOf(ConsultaCombo.Text)).Text <> '' then + begin + if where = '' then + where := ConsultaCombo.GetExprList(ConsultaCombo.Items.IndexOf(ConsultaCombo.Text)).Text + else + where := where + ' AND ' + + ConsultaCombo.GetExprList(ConsultaCombo.Items.IndexOf(ConsultaCombo.Text)).Text; + + end; + replaceReportSQLAddParam(report, stream, sqlResult.Text, Trim(where), Trim(order)); + free; end; - replaceReportSQLAddParam(report, stream, sqlResult.Text, Trim(where), Trim(order)); - free; + end + else + Report.Template.LoadFromStream(stream); + + + report.Units := utMillimeters; + if config.nomeImpressora<>'' then + report.PrinterSetup.PrinterName := + config.nomeImpressora; + if config.orientation = 1 then + report.PrinterSetup.Orientation := poPortrait; + if config.orientation = 2 then + report.PrinterSetup.Orientation := poLandscape; + + if config.alturaPapel <> -1 then + Report.PrinterSetup.PaperHeight := config.alturaPapel; + if config.larguraPapel <> -1 then + Report.PrinterSetup.PaperWidth := config.larguraPapel; + if config.margemInferior <> -1 then + Report.PrinterSetup.MarginBottom := config.margemInferior; + if config.margemEsquerda <> -1 then + Report.PrinterSetup.MarginLeft := config.margemEsquerda; + if config.margemDireita <> -1 then + Report.PrinterSetup.MarginRight := config.margemDireita; + if config.margemSuperior <> -1 then + Report.PrinterSetup.MarginTop := config.margemSuperior; + + if config.tipoSaida <> TSTela then + begin + if config.tipoSaida = TSPDF then extensao := 'pdf'; + if config.tipoSaida = TSTexto then extensao := 'txt'; + if FTextFileName = '' then + if not PromptForFileName(FTextFileName, '*.' + extensao, extensao, + '', '', true) then + exit; + + report.AllowPrintToFile := True; + report.TextFileName := FTextFileName; + report.ShowPrintDialog := false; + + if config.tipoSaida = TSPDF then + report.DeviceType := 'PDF'; + + if config.tipoSaida = TSTexto then + report.DeviceType := 'TextFile'; end; - end - else - Report.Template.LoadFromStream(stream); - - - report.Units := utMillimeters; - if config.nomeImpressora<>'' then - report.PrinterSetup.PrinterName := - config.nomeImpressora; - if config.orientation = 1 then - report.PrinterSetup.Orientation := poPortrait; - if config.orientation = 2 then - report.PrinterSetup.Orientation := poLandscape; - - if config.alturaPapel <> -1 then - Report.PrinterSetup.PaperHeight := config.alturaPapel; - if config.larguraPapel <> -1 then - Report.PrinterSetup.PaperWidth := config.larguraPapel; - if config.margemInferior <> -1 then - Report.PrinterSetup.MarginBottom := config.margemInferior; - if config.margemEsquerda <> -1 then - Report.PrinterSetup.MarginLeft := config.margemEsquerda; - if config.margemDireita <> -1 then - Report.PrinterSetup.MarginRight := config.margemDireita; - if config.margemSuperior <> -1 then - Report.PrinterSetup.MarginTop := config.margemSuperior; - - if config.tipoSaida <> TSTela then - begin - if config.tipoSaida = TSPDF then extensao := 'pdf'; - if config.tipoSaida = TSTexto then extensao := 'txt'; - if FTextFileName = '' then - if not PromptForFileName(FTextFileName, '*.' + extensao, extensao, - '', '', true) then - exit; - - report.AllowPrintToFile := True; - report.TextFileName := FTextFileName; - report.ShowPrintDialog := false; - - if config.tipoSaida = TSPDF then - report.DeviceType := 'PDF'; - - if config.tipoSaida = TSTexto then - report.DeviceType := 'TextFile'; - end; - updateContadorImpressao := MainData.GetQuery; - try - updateContadorImpressao.SQL.Text := 'UPDATE rb_item '+ - ' SET FREQUENCIAUSO = FREQUENCIAUSO+1, '+ - ' DATAULTIMAIMPRESSAO = ' - + QuotedStr(FormatDateTime('dd.mm.yyyy', MainData.GetServerDatetime)) + - ' WHERE ITEM_ID = ' + IntToStr(getTemplateIDByName(TemplateName)); - updateContadorImpressao.ExecSQL; + updateContadorImpressao := MainData.GetQuery; + try + updateContadorImpressao.SQL.Text := 'UPDATE rb_item '+ + ' SET FREQUENCIAUSO = FREQUENCIAUSO+1, '+ + ' DATAULTIMAIMPRESSAO = ' + + QuotedStr(FormatDateTime('dd.mm.yyyy', MainData.GetServerDatetime)) + + ' WHERE ITEM_ID = ' + IntToStr(getTemplateIDByName(TemplateName)); + updateContadorImpressao.ExecSQL; + finally + acCustomSQLMainData.FreeQuery(updateContadorImpressao); + end; + + TParametroSistemaData.RegistrarUsoRecurso(Config.NomeRelatorio, rrRelatorio); + report.Print; finally - acCustomSQLMainData.FreeQuery(updateContadorImpressao); + acCustomSQLMainData.FreeQuery(qry); end; - - report.Print; - end; procedure TImprimirRelatorioForm.ImprimirTemplate(templateName: string); diff --git a/Forms/osCustomMainFrm.dfm b/Forms/osCustomMainFrm.dfm index 9fbb655..2e2ce98 100644 --- a/Forms/osCustomMainFrm.dfm +++ b/Forms/osCustomMainFrm.dfm @@ -25,7 +25,6 @@ inherited osCustomMainForm: TosCustomMainForm Left = 11 Top = 2 Width = 268 - Height = 22 AutoSize = True ButtonHeight = 32 ButtonWidth = 32 @@ -198,8 +197,6 @@ inherited osCustomMainForm: TosCustomMainForm Align = alClient BevelOuter = bvNone TabOrder = 2 - ExplicitTop = 41 - ExplicitHeight = 585 object Splitter1: TSplitter Left = 165 Top = 33 @@ -281,7 +278,6 @@ inherited osCustomMainForm: TosCustomMainForm Height = 554 Align = alLeft TabOrder = 3 - ExplicitHeight = 552 object TreeView1: TTreeView Left = 1 Top = 1 @@ -299,7 +295,6 @@ inherited osCustomMainForm: TosCustomMainForm TabOrder = 0 OnChange = TreeView1Change OnCustomDrawItem = TreeView1CustomDrawItem - ExplicitHeight = 529 end object EdtPesquisa: TEdit Left = 1 @@ -312,7 +307,6 @@ inherited osCustomMainForm: TosCustomMainForm OnChange = EdtPesquisaChange OnEnter = EdtPesquisaEnter OnKeyDown = EdtPesquisaKeyDown - ExplicitTop = 530 end end end @@ -1869,7 +1863,7 @@ inherited osCustomMainForm: TosCustomMainForm DataPipeline = ppDBPipeline PrinterSetup.BinName = 'Default' PrinterSetup.DocumentName = 'Report' - PrinterSetup.PaperName = 'Custom' + PrinterSetup.PaperName = 'A4' PrinterSetup.PrinterName = 'Default' PrinterSetup.SaveDeviceSettings = False PrinterSetup.mmMarginBottom = 6350 @@ -1878,7 +1872,7 @@ inherited osCustomMainForm: TosCustomMainForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 297000 PrinterSetup.mmPaperWidth = 210000 - PrinterSetup.PaperSize = 256 + PrinterSetup.PaperSize = 9 Template.Format = ftASCII Units = utMillimeters ArchiveFileName = '($MyDocuments)\ReportArchive.raf' @@ -2043,7 +2037,7 @@ inherited osCustomMainForm: TosCustomMainForm AutoStop = False PrinterSetup.BinName = 'Default' PrinterSetup.DocumentName = 'Report' - PrinterSetup.PaperName = 'Custom' + PrinterSetup.PaperName = 'Carta' PrinterSetup.PrinterName = 'Default' PrinterSetup.SaveDeviceSettings = False PrinterSetup.mmMarginBottom = 6350 @@ -2052,7 +2046,7 @@ inherited osCustomMainForm: TosCustomMainForm PrinterSetup.mmMarginTop = 6350 PrinterSetup.mmPaperHeight = 279401 PrinterSetup.mmPaperWidth = 215900 - PrinterSetup.PaperSize = 256 + PrinterSetup.PaperSize = 1 Template.DatabaseSettings.DataPipeline = plItem Template.DatabaseSettings.NameField = 'Name' Template.DatabaseSettings.TemplateField = 'Template' diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index d39dd13..2aa724d 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -282,7 +282,8 @@ TosCustomMainForm = class(TosForm) implementation uses acCustomSQLMainDataUn, FilterDefEditFormUn, RecursoDataUn, - osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn, UMensagemAguarde; + osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn, UMensagemAguarde, StatusUnit, + ParametroSistemaDataUn; {$R *.DFM} @@ -376,6 +377,8 @@ procedure TosCustomMainForm.EditActionExecute(Sender: TObject); Form.VisibleButtons := Form.VisibleButtons + [vbImprimir]; if assigned(Self.FOnEditForm) then Self.FOnEditForm(Form); + + TParametroSistemaData.RegistrarUsoRecurso(FCurrentResource.Name, rrEdit); Form.Edit('ID', iID); if Form.IsModified then begin @@ -413,6 +416,7 @@ procedure TosCustomMainForm.NewActionExecute(Sender: TObject); begin Form := FCurrentEditForm; Form.VisibleButtons := [vbSalvarFechar]; + TParametroSistemaData.RegistrarUsoRecurso(FCurrentResource.Name, rrInsert); if PrintAction.Enabled then Form.VisibleButtons := Form.VisibleButtons + [vbImprimir]; Form.Insert; @@ -428,6 +432,7 @@ procedure TosCustomMainForm.DeleteActionExecute(Sender: TObject); Form := FCurrentEditForm; if Form <> nil then begin + TParametroSistemaData.RegistrarUsoRecurso(FCurrentResource.Name, rrDelete); Form.VisibleButtons := [vbExcluir, vbFechar]; if Form.Delete('ID', FIdField.AsInteger) then ExecLastFilter; @@ -781,6 +786,8 @@ procedure TosCustomMainForm.ResourceClick(Sender: TObject); CheckActionsExecute(self); if FCurrentForm is TosCustomEditForm then (FCurrentForm as TosCustomEditForm).VisibleButtons := [vbSalvarFechar]; + + TParametroSistemaData.RegistrarUsoRecurso(FCurrentResource.Name, rrOutro); FCurrentForm.ShowModal; finally Screen.Cursor := crDefault; @@ -1804,6 +1811,8 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; CheckActionsExecute(self); if FCurrentForm is TosCustomEditForm then (FCurrentForm as TosCustomEditForm).VisibleButtons := [vbSalvarFechar]; + + TParametroSistemaData.RegistrarUsoRecurso(FCurrentResource.Name, rrEdit); FCurrentForm.ShowModal; finally Screen.Cursor := crDefault; diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 78e88a8..6254583 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -30,7 +30,7 @@ type TIdade = class function getIdadeDias(idade: string; conn: TSQLConnection = nil): integer; function getTemplateByName(name: string; stream: TMemoryStream): boolean; - function getTemplateByID(id: integer; stream: TMemoryStream): boolean; + function getTemplateByID(id: integer; stream: TMemoryStream; var config: TConfigImpressao): boolean; function getTemplateIDByName(name: string): integer; function getTemplateLaudoRascunho(name: string; stream: TMemoryStream; var config: TConfigImpressao): boolean; @@ -197,7 +197,7 @@ function getTemplateIDByName(name: string): integer; end; -function getTemplateById(id: integer; stream: TMemoryStream): boolean; +function getTemplateById(id: integer; stream: TMemoryStream; var config: TConfigImpressao): boolean; var query: TosSQLDataset; report: string; @@ -205,39 +205,42 @@ function getTemplateById(id: integer; stream: TMemoryStream): boolean; ComponenteRelatorio: TacReportContainer; begin Result := false; - if Application.MainForm <> nil then - report := TacReportContainer(Application.MainForm.FindComponent('FReportDepot')).findReportById(id) - else - begin - //Dessa forma o agendador pode ter acesso ao componente de relatório - ComponenteRelatorio := TacReportContainer.Create(nil); - report := ComponenteRelatorio.findReportById(id); - end; - + query := TosSQLDataSet.Create(nil); try - if Length(report) > 0 then - begin - try - ss := TStringStream.Create(report); - stream.LoadFromStream(ss); - Result := True; - finally - FreeAndNil(ss); - end; - end + query.SQLConnection := acCustomSQLMainData.SQLConnection; + query.CommandText := ' SELECT ' + + ' template, '+ + ' name '+ + ' FROM ' + + ' RB_ITEM '+ + ' WHERE ' + + ' ITEM_ID = ' + intToStr(id); + query.Open; + if query.RecordCount>0 then + config.NomeRelatorio := query.FieldByName('name').AsString; + + if Application.MainForm <> nil then + report := TacReportContainer(Application.MainForm.FindComponent('FReportDepot')).findReportById(id) else begin - query := TosSQLDataSet.Create(nil); - try - query.SQLConnection := acCustomSQLMainData.SQLConnection; - query.CommandText := ' SELECT ' + - ' template, '+ - ' name '+ - ' FROM ' + - ' RB_ITEM '+ - ' WHERE ' + - ' ITEM_ID = ' + intToStr(id); - query.Open; + //Dessa forma o agendador pode ter acesso ao componente de relatório + ComponenteRelatorio := TacReportContainer.Create(nil); + report := ComponenteRelatorio.findReportById(id); + end; + + try + if Length(report) > 0 then + begin + try + ss := TStringStream.Create(report); + stream.LoadFromStream(ss); + Result := True; + finally + FreeAndNil(ss); + end; + end + else + begin if query.RecordCount>0 then begin TBLOBField(query.fields[0]).SaveToStream(stream); @@ -245,15 +248,16 @@ function getTemplateById(id: integer; stream: TMemoryStream): boolean; TacReportContainer(Application.MainForm.FindComponent('FReportDepot')).addReport(id, query.fields[1].AsString, query.fields[0].AsString) else ComponenteRelatorio.addReport(id, query.fields[1].AsString, query.fields[0].AsString); + config.NomeRelatorio := query.FieldByName('name').AsString; Result := True; end; - finally - FreeAndNil(query); end; + finally + if Application.MainForm = nil then + FreeAndNil(ComponenteRelatorio); end; finally - if Application.MainForm = nil then - FreeAndNil(ComponenteRelatorio); + FreeAndNil(query); end; end; diff --git a/Report/acCustomReportUn.dfm b/Report/acCustomReportUn.dfm index bba264f..0b232f3 100644 --- a/Report/acCustomReportUn.dfm +++ b/Report/acCustomReportUn.dfm @@ -30,7 +30,7 @@ object acCustomReport: TacCustomReport PrinterSetup.mmMarginTop = 14552 PrinterSetup.mmPaperHeight = 297000 PrinterSetup.mmPaperWidth = 210000 - PrinterSetup.PaperSize = 256 + PrinterSetup.PaperSize = 9 Units = utMillimeters ArchiveFileName = '($MyDocuments)\ReportArchive.raf' DeviceType = 'Screen' diff --git a/Report/acCustomReportUn.pas b/Report/acCustomReportUn.pas index 1fd0b4b..f7ecc66 100644 --- a/Report/acCustomReportUn.pas +++ b/Report/acCustomReportUn.pas @@ -26,6 +26,7 @@ TConfigImpressao = record margemDireita: double; tipoSaida: string; IDTemplate: integer; + NomeRelatorio: string; end; TAdendo = record @@ -77,8 +78,7 @@ TacCustomReport = class(TDataModule) beforePrint: TNotifyEvent; adendos: TAdendos; - function getTemplate(id: integer; stream: TMemoryStream; - var config: TConfigImpressao): boolean; virtual; + function getTemplate(id: integer; stream: TMemoryStream; var config: TConfigImpressao): boolean; virtual; procedure linkEvents; virtual; function casosEspeciais(valorOriginal: string): string; virtual; procedure ajustarAdendos; virtual; @@ -113,7 +113,7 @@ TReportClass = class of TacCustomReport; implementation uses acCustomSQLMainDataUn, osReportUtils, acCustomRelatorioDataUn, Dialogs, - acCustomParametroSistemaDataUn, osErrorHandler; + acCustomParametroSistemaDataUn, osErrorHandler, StatusUnit, ParametroSistemaDataUn; {$R *.dfm} @@ -167,7 +167,7 @@ procedure TacCustomReport.Print(const PID: integer); idTemplate := acCustomRelatorioData.getTemplateConfigForUser(ClassName, config); if idTemplate <> -1 then begin - if getTemplateByID(idTemplate, stream) then + if getTemplateByID(idTemplate, stream, config) then if stream.Size<>0 then begin encontrou := true; @@ -188,6 +188,7 @@ procedure TacCustomReport.Print(const PID: integer); if not(encontrou) then begin getTemplateByName(ClassName, stream); + config.NomeRelatorio := ClassName; if acCustomParametroSistemaData <> nil then config.nomeImpressora := acCustomParametroSistemaData.getNomeImpressoraClasse('LASER'); if stream.size<>0 then @@ -327,6 +328,8 @@ procedure TacCustomReport.Print(const PID: integer); else Report.Print; updateContadorImpressao := MainData.GetQuery; + + TParametroSistemaData.RegistrarUsoRecurso(Config.NomeRelatorio, rrRelatorio); try if idTemplate = 0 then idTemplate := config.IDTemplate; From e39e004b7a4775e457f50a7fd370eea403f2055d Mon Sep 17 00:00:00 2001 From: Claudio Date: Fri, 2 Jul 2021 09:53:59 -0300 Subject: [PATCH 235/294] =?UTF-8?q?Ticket=5FID:=20#98642=20-=20movendo=20a?= =?UTF-8?q?=20fun=C3=A7=C3=A3o=20LocalizaElementoArray=20do=20RequisicaoDa?= =?UTF-8?q?ta=20para=20o=20UtilsUnit?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a369eb2..cc2343a 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -138,7 +138,7 @@ function LoadFromFile(const aFileName: string): string; procedure UpdateProxy(dir: string); procedure RemoveDiretorio(Dir: String); function ExtractBetween(const Value, A, B: string): string; - +function LocalizaElementoArray(Element: array of Integer; Valor: Integer): Boolean; implementation @@ -2317,5 +2317,18 @@ function ExtractBetween(const Value, A, B: string): string; end; end; +function LocalizaElementoArray(Element: array of Integer; Valor: Integer): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to Length(Element) - 1 do + if Valor = Element[I] then + begin + Result := True; + break + end; +end; + end. From 9b86a41a4937b423e90b57d5a8d913325387a3bc Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 12 Jul 2021 14:39:06 -0300 Subject: [PATCH 236/294] ticket_id: #98006 - registro de uso dos recursos e relatorios --- Forms/osCustomMainFrm.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 2aa724d..06a6d1c 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1638,6 +1638,7 @@ procedure TosCustomMainForm.EditarTodosButtonClick(Sender: TObject); Form.VisibleButtons := Form.VisibleButtons + [vbImprimir]; if assigned(Self.FOnEditForm) then Self.FOnEditForm(Form); + TParametroSistemaData.RegistrarUsoRecurso(FCurrentResource.Name, rrEdit); Form.Edit('ID', iID); if Form.IsModified then begin From f013617e543dcc15322dc38ef8a4f1d3c4f2ca48 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 3 Aug 2021 10:53:31 -0300 Subject: [PATCH 237/294] Adicionando funcao getJsonValue --- Lib/UtilsUnit.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index cc2343a..c3bdb51 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -139,6 +139,7 @@ procedure UpdateProxy(dir: string); procedure RemoveDiretorio(Dir: String); function ExtractBetween(const Value, A, B: string): string; function LocalizaElementoArray(Element: array of Integer; Valor: Integer): Boolean; +function GetJsonValue(jsonObject: TJsonObject; campo: string): string; implementation @@ -2330,5 +2331,12 @@ function LocalizaElementoArray(Element: array of Integer; Valor: Integer): Boole end; end; +function GetJsonValue(jsonObject: TJsonObject; campo: string): string; +begin + Result := ''; + if jsonObject.Get(campo) <> nil then + Result := jsonObject.Get(campo).JsonValue.Value; +end; + end. From 781eebf07b104a674dafe0a62be5045835edfdf9 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 22 Sep 2021 13:09:50 -0300 Subject: [PATCH 238/294] ticket_id: #99007 - melhoria no arredondamento do valores da requisicao --- Lib/UtilsUnit.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index c3bdb51..1d6ab2b 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -671,13 +671,15 @@ function RoundToCurrency(const AValue: Currency; const ADigit: TRoundToRange): C var LFactor: Extended; rmOrig: TFPURoundingMode; + Valor: real; begin rmOrig := GetRoundMode(); if rmOrig <> rmNearest then SetRoundMode(rmNearest); + Valor := AValue; //Faz o cast pra float LFactor := IntPower(10, ADigit); - Result := Round(AValue / LFactor) * LFactor; + Result := Round(Valor / LFactor) * LFactor; if rmOrig <> rmNearest then SetRoundMode(rmOrig); From e911c2cb1957c1dd75258036529036770a145353 Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 8 Dec 2021 17:26:02 -0300 Subject: [PATCH 239/294] =?UTF-8?q?Ticket=5FID:=20#102312=20-=20corre?= =?UTF-8?q?=C3=A7=C3=A3o=20no=20calculo=20da=20idade=20considerando=20ano?= =?UTF-8?q?=20bissexto?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osReportUtils.pas | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 6254583..3ce470e 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -554,20 +554,19 @@ function TIdade.getString: string; Total_dias:= FDias; Ano := StrToInt(FormatDateTime('YY', DataNascimento)); Ano2 := StrToInt(FormatDateTime('YYYY', DataNascimento)); + Mes := StrToInt(FormatDateTime('MM', DataNascimento)); + mesano:= Mes; + if mes > 2 then + Inc(Ano2); + while Total_dias >= DaysInAYear(Ano2) do begin - if (IsLeapYear(Ano2)) and (Count = 1) then - begin - Total_dias := Total_dias + 1; - end; Total_dias := Total_dias - DaysInAYear(Ano2); Ano := Ano + 1; Ano2 := Ano2 + 1; inc(count); end; - - Mes := StrToInt(FormatDateTime('MM', DataNascimento)); - mesano:= Mes; + while Total_dias > 28 do begin if Total_dias >= DaysInAMonth(Ano, Mes) then From f2b04149a26e9e4dd5933b1f4bb3dc7644e5f69c Mon Sep 17 00:00:00 2001 From: Claudio Date: Tue, 25 Jan 2022 10:35:35 -0300 Subject: [PATCH 240/294] =?UTF-8?q?Ticket=5FID:=20#103229=20-=20N=C3=A3o?= =?UTF-8?q?=20deixar=20logar=20usuario=20inativo=20quando=20pede=20usuario?= =?UTF-8?q?=20com=20permiss=C3=A3o=20especial?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/osLogin.pas | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Lib/osLogin.pas b/Lib/osLogin.pas index 805036d..4ef3de6 100644 --- a/Lib/osLogin.pas +++ b/Lib/osLogin.pas @@ -33,7 +33,7 @@ TLoginUsuario = class implementation -uses DB, osMD5; +uses DB, osMD5, StatusUnit; constructor TLoginUsuario.create; begin @@ -168,6 +168,11 @@ function TLoginUsuario.Login(caption: string; LoginForm.FocusedControl := LoginForm.PasswordEdit; Inc(ErrorCount); end + else if query.FieldByName('Status').AsString <> stuAtivo then + begin + MessageDlg('Usuário Inativo.', mtError, [mbOK], 0); + LoginForm.FocusedControl := LoginForm.UsernameEdit; + end else begin FIDUsuario := query.fieldByName('IDUsuario').AsInteger; From 3ee5b6b95d648cbbc9b79b33a538aec24f876cdf Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 4 Apr 2022 16:56:31 -0300 Subject: [PATCH 241/294] removendo warning --- Lib/osReportUtils.pas | 3 --- 1 file changed, 3 deletions(-) diff --git a/Lib/osReportUtils.pas b/Lib/osReportUtils.pas index 3ce470e..bbab090 100644 --- a/Lib/osReportUtils.pas +++ b/Lib/osReportUtils.pas @@ -546,9 +546,7 @@ function TIdade.getString: string; ano, ano2: Integer; dataNascimento: TDateTime; Total_dias: Real; - Count: Integer; begin - Count:= 1; DataNascimento:= FdataReferencia - Fdias; Total_dias:= FDias; @@ -564,7 +562,6 @@ function TIdade.getString: string; Total_dias := Total_dias - DaysInAYear(Ano2); Ano := Ano + 1; Ano2 := Ano2 + 1; - inc(count); end; while Total_dias > 28 do From 16085787ecf455c52770347bb5a7ceb49de5a3dc Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 15 Jun 2022 15:23:19 -0300 Subject: [PATCH 242/294] Adicionando metodo MakeRounded --- Lib/UtilsUnitGUI.pas | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 5702d23..5ba6b48 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -58,6 +58,7 @@ procedure CloseProcess(const aProcessInformation: TProcessInformation); function LocalIp: string; function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; +procedure MakeRounded(Control: TWinControl); implementation @@ -853,6 +854,23 @@ function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDW end; end; +procedure MakeRounded(Control: TWinControl); +var + R: TRect; + Rgn: HRGN; +begin + with Control do + begin + R := ClientRect; + rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20); + Perform(EM_GETRECT, 0, lParam(@r)); + InflateRect(r, - 10, - 10); + Perform(EM_SETRECTNP, 0, lParam(@r)); + SetWindowRgn(Handle, rgn, True); + Invalidate; + end; +end; + end. From cedfe65c4f03f4660a92b1f7e6d2f34d547fbf36 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 8 Jul 2022 08:15:28 -0300 Subject: [PATCH 243/294] =?UTF-8?q?Se=20o=20dataset=20n=C3=A3o=20estiver?= =?UTF-8?q?=20aberto,=20copiar=20apenas=20os=20campos,=20dessa=20forma=20n?= =?UTF-8?q?=C3=A3o=20da=20erro?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 1d6ab2b..6d6320a 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1074,17 +1074,20 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien end; - cdsOrigem.First; - while not cdsOrigem.Eof do + if cdsOrigem.State <> dsInactive then begin - cdsDestino.Append; - for i := 0 to cdsOrigem.FieldCount-1 do + cdsOrigem.First; + while not cdsOrigem.Eof do begin - if (not cdsOrigem.Fields[i].IsNull) and (cdsDestino.FindField(cdsOrigem.Fields[i].FieldName) <> nil) then - cdsDestino.FieldByName(cdsOrigem.Fields[i].FieldName).AsString := cdsOrigem.FieldByName(cdsOrigem.Fields[i].FieldName).AsString; + cdsDestino.Append; + for i := 0 to cdsOrigem.FieldCount-1 do + begin + if (not cdsOrigem.Fields[i].IsNull) and (cdsDestino.FindField(cdsOrigem.Fields[i].FieldName) <> nil) then + cdsDestino.FieldByName(cdsOrigem.Fields[i].FieldName).AsString := cdsOrigem.FieldByName(cdsOrigem.Fields[i].FieldName).AsString; + end; + cdsDestino.Post; + cdsOrigem.Next; end; - cdsDestino.Post; - cdsOrigem.Next; end; end; From db90457192469ac45fcb4e9140abb159a5366188 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 14 Jul 2022 09:43:34 -0300 Subject: [PATCH 244/294] ticket_id: #105999 - Publicacao Digital em DLL, fazer com que a publicacao manual, exiba o texto do console se houver erro na publicacao --- Lib/UtilsUnitGUI.pas | 55 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 5ba6b48..d37a4a1 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -53,6 +53,7 @@ function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; procedure ExecuteAndWait(const aCommando: string); function Execute(const aCommando: string; const ShowWindow: boolean; var aProcessInformation: TProcessInformation): boolean; +function GetDosOutput(CommandLine: string): string; procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); procedure CloseProcess(const aProcessInformation: TProcessInformation); function LocalIp: string; @@ -670,6 +671,60 @@ function Execute(const aCommando: string; const ShowWindow: boolean; var aProces end; end; +function GetDosOutput(CommandLine: string): string; +var + SA: TSecurityAttributes; + SI: TStartupInfo; + PI: TProcessInformation; + StdOutPipeRead, StdOutPipeWrite: THandle; + WasOK: Boolean; + Buffer: array[0..255] of AnsiChar; + BytesRead: Cardinal; + WorkDir: string; + Handle: Boolean; +begin + Result := ''; + with SA do begin + nLength := SizeOf(SA); + bInheritHandle := True; + lpSecurityDescriptor := nil; + end; + CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0); + try + with SI do + begin + FillChar(SI, SizeOf(SI), 0); + cb := SizeOf(SI); + dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; + wShowWindow := SW_HIDE; + hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin + hStdOutput := StdOutPipeWrite; + hStdError := StdOutPipeWrite; + end; + Handle := CreateProcess(nil, PChar(CommandLine), + nil, nil, True, 0, nil, + nil, SI, PI); + CloseHandle(StdOutPipeWrite); + if Handle then + try + repeat + WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil); + if BytesRead > 0 then + begin + Buffer[BytesRead] := #0; + Result := Result + Buffer; + end; + until not WasOK or (BytesRead = 0); + WaitForSingleObject(PI.hProcess, INFINITE); + finally + CloseHandle(PI.hThread); + CloseHandle(PI.hProcess); + end; + finally + CloseHandle(StdOutPipeRead); + end; +end; + function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean; var client : sockaddr_in; From 97a1fc3858288801dd6c641f5599cc3945b0fe33 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 27 Jul 2022 16:59:05 -0300 Subject: [PATCH 245/294] removendo warning --- Lib/UtilsUnitGUI.pas | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index d37a4a1..60394c3 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -680,7 +680,6 @@ function GetDosOutput(CommandLine: string): string; WasOK: Boolean; Buffer: array[0..255] of AnsiChar; BytesRead: Cardinal; - WorkDir: string; Handle: Boolean; begin Result := ''; @@ -712,7 +711,7 @@ function GetDosOutput(CommandLine: string): string; if BytesRead > 0 then begin Buffer[BytesRead] := #0; - Result := Result + Buffer; + Result := Result + String(Buffer); end; until not WasOK or (BytesRead = 0); WaitForSingleObject(PI.hProcess, INFINITE); From 39a31dc9a3305858cfaed60f7d2372e659a706e0 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 27 Jul 2022 16:59:16 -0300 Subject: [PATCH 246/294] resolver erro de I/O --- Lib/UtilsUnit.pas | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 6d6320a..e82c9ec 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -2202,18 +2202,26 @@ procedure SaveToFile(const aFilename, aContent: string); var FileStream: TFileStream; _FH: NativeUInt; + FFileLock: THandle; begin - if not FileExists(aFilename) then - _FH := fmCreate - else - _FH := fmOpenReadWrite; - - FileStream := TFileStream.Create(aFileName, _FH, fmShareDenyNone); + FFileLock := CreateMutex(nil, False, 'UtilsUnit_FileLock'); + WaitForSingleObject(FFileLock, INFINITE); try - FileStream.Seek(0, soFromEnd); - FileStream.WriteBuffer(Pointer(aContent)^, (Length(aContent) * szChar)); + if not FileExists(aFilename) then + _FH := fmCreate + else + _FH := fmOpenReadWrite; + + FileStream := TFileStream.Create(aFileName, _FH, fmShareDenyNone); + try + FileStream.Seek(0, soFromEnd); + FileStream.WriteBuffer(Pointer(aContent)^, (Length(aContent) * szChar)); + finally + FileStream.Free; + end; finally - FileStream.Free; + ReleaseMutex(FFileLock); + CloseHandle(FFileLock); end; end; From 7bdfd8ddc59eb9cb0d206fe01245478293439d21 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 28 Jul 2022 08:50:14 -0300 Subject: [PATCH 247/294] =?UTF-8?q?ticket=5Fid:=20#107328=20-=20adicionand?= =?UTF-8?q?o=20uso=20do=20TLS/SSL=20ao=20componente=20de=20conex=C3=A3o?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index e82c9ec..687baaa 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -2144,6 +2144,9 @@ function getJsonStringFromServer(const aURL: string; var aException: string): st if aURL.ToLower.Contains('https') then begin IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(_http); + IOHandler.SSLOptions.Method := sslvSSLv23; + IOHandler.SSLOptions.Mode := sslmUnassigned; + IOHandler.SSLOptions.SSLVersions := [sslvSSLv2,sslvSSLv3,sslvTLSv1,sslvTLSv1_1,sslvTLSv1_2]; _http.IOHandler := IOHandler; end; try From 82ca3a71b4efcdd940175cc69ff3dce9c93fffda Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 2 Aug 2022 15:49:58 -0300 Subject: [PATCH 248/294] ticket_id: #107046 Copiar cadastro de exame (corrigindo erro) --- Lib/UtilsUnitGUI.pas | 48 +++++++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 60394c3..254077f 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -445,13 +445,16 @@ function CriarMsgLogInclusaoExclusaoCDS(AlteradoCDS: TClientDataSet; OriginalCDS Result := EmptyStr; AlteradoCDS.DisableControls; try - // Verifica Registros Excluidos - Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS, AlteradoCDS, sCampoChave, aCampoDescricao, - 'Exclusão: '); + if OriginalCDS <> nil then + begin + // Verifica Registros Excluidos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS, AlteradoCDS, sCampoChave, aCampoDescricao, + 'Exclusão: '); - // Verifica Registros Incluídos - Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(AlteradoCDS, OriginalCDS, sCampoChave, aCampoDescricao, - 'Inclusão: '); + // Verifica Registros Incluídos + Result := Result + CriarMsgLogCDSNotLocateOrigemDestino(AlteradoCDS, OriginalCDS, sCampoChave, aCampoDescricao, + 'Inclusão: '); + end; finally AlteradoCDS.EnableControls; end; @@ -467,28 +470,31 @@ function CriarMsgLogCDSNotLocateOrigemDestino(OriginalCDS: TClientDataSet; Alter begin Result := EmptyStr; _Str := TStringList.Create; - try - OriginalCDS.First; - while not OriginalCDS.Eof do - begin - if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then + if OriginalCDS <> nil then + begin + try + OriginalCDS.First; + while not OriginalCDS.Eof do begin - if Length(aCampoDescricao) > 0 then + if not AlteradoCDS.Locate(sCampoChave, OriginalCDS.FieldByName(sCampoChave).AsVariant, []) then begin - aMsgReg := EmptyStr; - for nRegCol := 0 to Length(aCampoDescricao)-1 do + if Length(aCampoDescricao) > 0 then begin - _valor := getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); - if _valor <> EmptyStr then - _Str.Add(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).DisplayLabel + ': '+ _valor); + aMsgReg := EmptyStr; + for nRegCol := 0 to Length(aCampoDescricao)-1 do + begin + _valor := getCampoSemRTF(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).AsString); + if _valor <> EmptyStr then + _Str.Add(OriginalCDS.FieldByName(aCampoDescricao[nRegCol]).DisplayLabel + ': '+ _valor); + end; end; + Result := Result + #13 + sDescricao + _Str.CommaText; end; - Result := Result + #13 + sDescricao + _Str.CommaText; + OriginalCDS.Next; end; - OriginalCDS.Next; + finally + FreeAndNil(_Str); end; - finally - FreeAndNil(_Str); end; end; From ce733f7ae478e4109b8c12141526f29863283fa1 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 29 Aug 2022 18:06:24 -0300 Subject: [PATCH 249/294] =?UTF-8?q?Agendador=20-=20Mudando=20a=20forma=20c?= =?UTF-8?q?omo=20o=20guardiao=20trabalha,=20o=20servidor=20=C3=A9=20o=20ag?= =?UTF-8?q?endador=20e=20o=20client=20=C3=A9=20a=20dll?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnitGUI.pas | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 254077f..9fa25cc 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -60,6 +60,7 @@ function LocalIp: string; function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : Boolean; function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; procedure MakeRounded(Control: TWinControl); +function SendMessageToTCPServer(const aMessage: string; aPort: integer): boolean; implementation @@ -755,7 +756,6 @@ function PortTCP_IsOpen(dwPort : Word; ipAddressStr:AnsiString) : boolean; function SendMessageToTCPServer(const aMessage: string; aPort: integer): boolean; var IdTCP: TIdTCPClient; - msg: string; begin Result := False; try @@ -770,7 +770,6 @@ function SendMessageToTCPServer(const aMessage: string; aPort: integer): boolean begin IdTCP.IOHandler.WriteLn(aMessage); IdTCP.IOHandler.ReadTimeout := 500; - msg := IdTCP.IOHandler.Readln; end; finally From eb2f08eb56ed4beb6d274d917fe6ebaae6bc63cc Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 5 Sep 2022 09:56:19 -0300 Subject: [PATCH 250/294] ticket_id: #107812 - correcao dos logs quando usuario faz logout e login --- Forms/osCustomMainFrm.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 06a6d1c..854a571 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -283,7 +283,7 @@ implementation uses acCustomSQLMainDataUn, FilterDefEditFormUn, RecursoDataUn, osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn, UMensagemAguarde, StatusUnit, - ParametroSistemaDataUn; + ParametroSistemaDataUn, LogDataUn; {$R *.DFM} @@ -1219,6 +1219,9 @@ function TosCustomMainForm.Login: boolean; acCustomSQLMainData.GetUserInfo(FUserName); + if LogData <> nil then + LogData.setUsuarioLogado(acCustomSQLMainData.IDUsuario); + StatusBar.Panels[1].Text := FUsername; cds.Params.Clear; if FUserName=FSuperUserName then From 0dea31db863b219361e5c78e7e6d2b11ec90095b Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 29 Sep 2022 09:05:41 -0300 Subject: [PATCH 251/294] abrir o spartacus minimizado --- Lib/UtilsUnitGUI.pas | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 9fa25cc..20ce739 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -656,18 +656,24 @@ function Execute(const aCommando: string; const ShowWindow: boolean; var aProces tmpStartupInfo: TStartupInfo; tmpProgram: String; CreationFlags: Cardinal; + nHwnd: Hwnd; begin tmpProgram := trim(aCommando); FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0); with tmpStartupInfo do begin cb := SizeOf(TStartupInfo); - wShowWindow := SW_HIDE; + + if ShowWindow then + wShowWindow := SW_SHOWMINNOACTIVE + else + wShowWindow := SW_HIDE; end; if ShowWindow then CreationFlags := NORMAL_PRIORITY_CLASS else CreationFlags := CREATE_NO_WINDOW or CREATE_DEFAULT_ERROR_MODE; + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CreationFlags, nil, nil, tmpStartupInfo, aProcessInformation) then Result := True @@ -676,6 +682,8 @@ function Execute(const aCommando: string; const ShowWindow: boolean; var aProces Result := False; RaiseLastOSError; end; + nHwnd := FindWindow ('Spartacus', ''); + SendMessage(nHwnd, WM_SYSCOMMAND, SC_MINIMIZE, 0) end; function GetDosOutput(CommandLine: string): string; From 05470c2af3a2d30a7907493a8de0f4892d1b06a6 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 11 Oct 2022 15:53:40 -0300 Subject: [PATCH 252/294] ticket_id: #108631 - Adicionando criptografia a senha do banco no arquivo appParams.ini --- Datamodules/acCustomSQLMainDataUn.pas | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 75b23e0..e0e065e 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -108,7 +108,7 @@ TacCustomSQLMainData = class(TDataModule) implementation -uses EscolhaConexaoFormUn; +uses EscolhaConexaoFormUn, acStrUtils; {$R *.dfm} @@ -356,8 +356,25 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); for i := 0 to Count - 1 do begin sName := Names[i]; - SQLConnection.Params.Values[sName] := Values[sName]; - SQLConnectionMeta.Params.Values[sName] := Values[sName]; + if UpperCase(sName) = 'PASSWORD' then + begin + if Copy(Values[sName], Values[sName].Length - 1, 2) = '==' then // == indica que a senha esta criptografada + begin + SQLConnection.Params.Values[sName] := simpleDecrypt(Copy(Values[sName], 1, Values[sName].Length - 1)); + SQLConnectionMeta.Params.Values[sName] := simpleDecrypt(Copy(Values[sName], 1, Values[sName].Length - 1)); + end + else + begin + //Altera o arquivo para salvar a senha criptografada + Values[sName] := simpleCrypt(Values[sName]) + '=='; + SaveToFile(selectParamsFileName); + end; + end + else + begin + SQLConnection.Params.Values[sName] := Values[sName]; + SQLConnectionMeta.Params.Values[sName] := Values[sName]; + end; end; if SQLConnectionMeta.Params.Values['DataBaseMeta']<>'' then SQLConnectionMeta.Params.Values['Database'] := From ab825d9ccd8762e74f19e873f3e3e5ae48367e65 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 19 Oct 2022 10:02:00 -0300 Subject: [PATCH 253/294] ticket_id: #108903 - melhorando a forma como o clonar dataset funciona --- Lib/UtilsUnit.pas | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 687baaa..8247eb4 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1019,6 +1019,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien field := TMemoField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TIntegerField then field := TIntegerField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TLargeIntField then + field := TLargeIntField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateTimeField then field := TDateTimeField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateField then @@ -1060,10 +1062,11 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien else field := TStringField.Create(cdsDestino); - Field.FieldKind := fkData; + Field.FieldKind := cdsOrigem.Fields[i].FieldKind; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; + Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; @@ -1104,6 +1107,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa field := TMemoField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TIntegerField then field := TIntegerField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TLargeIntField then + field := TLargeIntField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateTimeField then field := TDateTimeField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateField then @@ -1115,10 +1120,11 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa else field := TStringField.Create(cdsDestino); - Field.FieldKind := fkData; + Field.FieldKind := cdsOrigem.Fields[i].FieldKind; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; + Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 4748ff10da9364cf94763cdbb30c6ebd0f475ee8 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 19 Oct 2022 10:02:53 -0300 Subject: [PATCH 254/294] ticket_id: #108903 - melhorando a forma como o clonar dataset funciona --- Lib/UtilsUnit.pas | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 687baaa..8247eb4 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1019,6 +1019,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien field := TMemoField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TIntegerField then field := TIntegerField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TLargeIntField then + field := TLargeIntField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateTimeField then field := TDateTimeField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateField then @@ -1060,10 +1062,11 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien else field := TStringField.Create(cdsDestino); - Field.FieldKind := fkData; + Field.FieldKind := cdsOrigem.Fields[i].FieldKind; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; + Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; @@ -1104,6 +1107,8 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa field := TMemoField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TIntegerField then field := TIntegerField.Create(cdsDestino) + else if (cdsOrigem.Fields[i]) is TLargeIntField then + field := TLargeIntField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateTimeField then field := TDateTimeField.Create(cdsDestino) else if (cdsOrigem.Fields[i]) is TDateField then @@ -1115,10 +1120,11 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa else field := TStringField.Create(cdsDestino); - Field.FieldKind := fkData; + Field.FieldKind := cdsOrigem.Fields[i].FieldKind; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; + Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 66cacc8bf8eb79fe6e4c264300b62839b4a48a54 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 20 Oct 2022 09:33:58 -0300 Subject: [PATCH 255/294] ticket_id: #108631 - LGPD, criptografia da senha do APPParams --- Datamodules/acCustomSQLMainDataUn.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index e0e065e..1d6b5e0 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -49,7 +49,7 @@ TacCustomSQLMainData = class(TDataModule) SQLConnectionMeta: TosSQLConnection; procedure DataModuleCreate(Sender: TObject); private - + protected BD: string; FQueryList: TObjectList; @@ -61,6 +61,8 @@ TacCustomSQLMainData = class(TDataModule) FApelidoUsuario: String; FRefreshTableList: TRefreshTableList; FProfile: string; + FSenhaFirebird: string; + FUsuarioFirebird: string; function selectParamsFileName: string; public @@ -365,10 +367,18 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); end else begin + SQLConnection.Params.Values[sName] := Values[sName]; + SQLConnectionMeta.Params.Values[sName] := Values[sName]; + //Altera o arquivo para salvar a senha criptografada Values[sName] := simpleCrypt(Values[sName]) + '=='; SaveToFile(selectParamsFileName); end; + FSenhaFirebird := SQLConnection.Params.Values[sName]; + end + else if UpperCase(sName) = 'USER_NAME' then + begin + FUsuarioFirebird := Values[sName] end else begin From e2bb0c1072b250272eda46ea1b0a024d6be72216 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 20 Oct 2022 14:35:39 -0300 Subject: [PATCH 256/294] ticket_id: #108631 - LGPD, criptografia da senha do APPParams --- Lib/UtilsUnit.pas | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8247eb4..167eacd 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1062,11 +1062,10 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien else field := TStringField.Create(cdsDestino); - Field.FieldKind := cdsOrigem.Fields[i].FieldKind; + Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; - Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; @@ -1120,11 +1119,10 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa else field := TStringField.Create(cdsDestino); - Field.FieldKind := cdsOrigem.Fields[i].FieldKind; + Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; - Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 190de32536ceb07d5c0605721c45c539b28a2efc Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 20 Oct 2022 14:43:34 -0300 Subject: [PATCH 257/294] ticket_id: #108631 - LGPD, criptografia da senha do APPParams --- Lib/UtilsUnit.pas | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8247eb4..167eacd 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1062,11 +1062,10 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TClientDataSet; cdsDestino: TClien else field := TStringField.Create(cdsDestino); - Field.FieldKind := cdsOrigem.Fields[i].FieldKind; + Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; - Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; @@ -1120,11 +1119,10 @@ procedure ClonarDadosClientDataSet(cdsOrigem: TSQLDataSet; cdsDestino: TClientDa else field := TStringField.Create(cdsDestino); - Field.FieldKind := cdsOrigem.Fields[i].FieldKind; + Field.FieldKind := fkData; Field.FieldName := cdsOrigem.Fields[i].FieldName; Field.DisplayLabel := cdsOrigem.Fields[i].DisplayLabel; Field.Visible := cdsOrigem.Fields[i].Visible; - Field.ProviderFlags := cdsOrigem.Fields[i].ProviderFlags; if (cdsOrigem.Fields[i] is TStringField) then Field.Size := cdsOrigem.Fields[i].Size; Field.DataSet := cdsDestino; From 4fd8ad8caca6b76a9263860dbd06dca049dc7d97 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 25 Oct 2022 11:45:44 -0300 Subject: [PATCH 258/294] ticket_id: #108631 - LGPD, criptografia da senha do APPParams --- Datamodules/acCustomSQLMainDataUn.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 1d6b5e0..eedcc6f 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -371,8 +371,11 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); SQLConnectionMeta.Params.Values[sName] := Values[sName]; //Altera o arquivo para salvar a senha criptografada - Values[sName] := simpleCrypt(Values[sName]) + '=='; - SaveToFile(selectParamsFileName); + if (UpperCase(extractfilename(application.exename)) = 'LABMASTER.EXE') or (UpperCase(extractfilename(application.exename)) = 'LABPLUS.EXE') then + begin + Values[sName] := simpleCrypt(Values[sName]) + '=='; + SaveToFile(selectParamsFileName); + end; end; FSenhaFirebird := SQLConnection.Params.Values[sName]; end From 9cc21457a64ff5bfc5da23c78c7fa50b440d9319 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 26 Oct 2022 17:22:55 -0300 Subject: [PATCH 259/294] ticket_id: #108631 - LGPD, criptografia da senha do APPParams --- Datamodules/acCustomSQLMainDataUn.pas | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index eedcc6f..3532df5 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -379,14 +379,12 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); end; FSenhaFirebird := SQLConnection.Params.Values[sName]; end - else if UpperCase(sName) = 'USER_NAME' then - begin - FUsuarioFirebird := Values[sName] - end else begin SQLConnection.Params.Values[sName] := Values[sName]; SQLConnectionMeta.Params.Values[sName] := Values[sName]; + if UpperCase(sName) = 'USER_NAME' then + FUsuarioFirebird := Values[sName] end; end; if SQLConnectionMeta.Params.Values['DataBaseMeta']<>'' then From 6560eabdd2a10f6ca53c0d3d62eb4a6798995e92 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 8 Nov 2022 14:09:24 -0300 Subject: [PATCH 260/294] Evitar erro de abrir tela sem um dataset (de forma proposital) --- Forms/osCustomEditFrm.pas | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 0001889..d9f27f4 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -360,13 +360,16 @@ procedure TosCustomEditForm.SetDatamodule(const Value: TDatamodule); procedure TosCustomEditForm.CheckChanges; begin - if (FMasterDataset.ChangeCount > 0) or //(FMasterDataset.UpdateStatus=usModified) or - (fmasterdataset.state in [dsEdit, dsInsert]) then - - if (MessageDlg('Os dados foram alterados. Salvar antes de sair?', mtConfirmation, - [mbYes, mbNo], 0) = mrYes) then + if FMasterDataset <> nil then begin - SaveAction.Execute; + if (FMasterDataset.ChangeCount > 0) or //(FMasterDataset.UpdateStatus=usModified) or + (fmasterdataset.state in [dsEdit, dsInsert]) then + + if (MessageDlg('Os dados foram alterados. Salvar antes de sair?', mtConfirmation, + [mbYes, mbNo], 0) = mrYes) then + begin + SaveAction.Execute; + end; end; end; From df3063bd77cb934b9d751e69d3ed6f1714eb62c3 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 9 Dec 2022 10:44:31 -0300 Subject: [PATCH 261/294] ticket_id: #110140 - mudar mensagem quando acontece erro de deadlock e nao perder as alteracoes do usuario --- Forms/osCustomEditFrm.pas | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 0001889..c2fc0c6 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -489,7 +489,15 @@ procedure TosCustomEditForm.ReconcileError(DataSet: TCustomClientDataSet; if (E.ErrorCode=1) and (UpdateKind=ukDelete) then MessageDlg('Não é possível excluir este registro pois existem dados no sistema que dependem dele.', mtError, [mbOK], 0) else - ShowMessage('Erro no clientDataSet com a mensagem: ' + quotedStr(E.message)); + begin + if Pos( 'deadlock', E.message) > 0 then + begin + ShowMessage('Esse registro esta sendo atualizado (sincronizado) pelo Híbrido ou outro usuário, salve novamente e verifique se as alterações foram aplicadas corretamente'); + Action := raCorrect; + end + else + ShowMessage('Erro no clientDataSet com a mensagem: ' + quotedStr(E.message)); + end; end; procedure TosCustomEditForm.FormCreate(Sender: TObject); From 40b321ccc719ee20f05f471971d4e384e9983858 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 29 Dec 2022 17:11:52 -0300 Subject: [PATCH 262/294] ticket_id: #110532 - fazer com que a permissao de "Visualizacao" abra o formulario --- Forms/osCustomMainFrm.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 854a571..a0c3b4c 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1788,6 +1788,8 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; if Assigned(FCurrentForm) then FreeAndNil(FCurrentForm); + OnSelectResourceAction.Execute; + // Limpa o Template corrente FCurrentTemplate.Clear; @@ -1797,7 +1799,10 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; end else if FCurrentResource.ResType = rtEdit then begin - FActionDblClick := EditAction; + if EditAction.Enabled then + FActionDblClick := EditAction + else if ViewAction.Enabled then + FActionDblClick := ViewAction; FCurrentEditForm := CreateCurrentEditForm; if Assigned(FCurrentEditForm) and Assigned(FCurrentDatamodule) then FCurrentEditForm.Datamodule := FCurrentDatamodule; @@ -1805,7 +1810,7 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; else if FCurrentResource.ResType = rtOther then FCurrentForm := CreateCurrentForm; - OnSelectResourceAction.Execute; + end; if FCurrentResource.ResType = rtOther then From b99a33c1d0fec586c0c06851005d5bb1aee1519c Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 2 Jan 2023 11:52:47 -0300 Subject: [PATCH 263/294] ticket_id: #110532 - fazer com que a permissao de "Visualizacao" abra o formulario --- Forms/osCustomMainFrm.pas | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index a0c3b4c..da86220 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -546,6 +546,14 @@ procedure TosCustomMainForm.CheckActionsExecute(Sender: TObject); if ComponentNotFound or ComponentIsNotAction then raise Exception.Create(ExceptionMsg + 'Contate o administrador.'); checkOperations; + + if FCurrentResource.ResType = rtEdit then + begin + if EditAction.Enabled then + FActionDblClick := EditAction + else if ViewAction.Enabled then + FActionDblClick := ViewAction; + end; end; procedure TosCustomMainForm.FilterActionExecute(Sender: TObject); From 8c8328e30cf5625139a70e80a81fbebd97eb9287 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 2 Jan 2023 12:17:03 -0300 Subject: [PATCH 264/294] ticket_id: #110532 - fazer com que a permissao de "Visualizacao" abra o formulario --- Forms/osCustomEditFrm.pas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 8dfee2b..da1f5f8 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -170,7 +170,7 @@ function TosCustomEditForm.View(const KeyFields: string; const KeyValues: Varian FFormMode := fmView; CheckMasterDataset; - FMasterDataset.ReadOnly := True; + //FMasterDataset.ReadOnly := True; ParseParams(FMasterDataset.Params, KeyFields, KeyValues); FMasterDataset.Close; FMasterDataset.Open; @@ -377,7 +377,8 @@ procedure TosCustomEditForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin inherited; - CheckChanges; + if FormMode <> fmView then + CheckChanges; end; procedure TosCustomEditForm.NewActionExecute(Sender: TObject); From 65750f3211f1007204c62be7cae556ba90ed0a26 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 4 Jan 2023 17:01:52 -0300 Subject: [PATCH 265/294] ticket_id: #110532 - fazer com que a permissao de "Visualizacao" abra o formulario --- Forms/osCustomEditFrm.pas | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index da1f5f8..8024194 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -210,9 +210,12 @@ procedure TosCustomEditForm.SetExternalCDS(const Value: TosClientDataset); procedure TosCustomEditForm.MasterDatasetAfterEdit(DataSet: TDataSet); begin inherited; - SaveAction.Enabled := True; - SaveCloseAction.Enabled := True; - SaveNewAction.Enabled := oInserir in Operacoes; + if not (FormMode in [fmView, fmDelete]) then + begin + SaveAction.Enabled := True; + SaveCloseAction.Enabled := True; + SaveNewAction.Enabled := oInserir in Operacoes; + end; end; procedure TosCustomEditForm.FormShow(Sender: TObject); From 214b01bbc5666565c0c18031cd33bc55765f8764 Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 9 Jan 2023 09:31:12 -0300 Subject: [PATCH 266/294] Correcao de merge, nao fazer a criptografia da senha do AppParams nessa versao ainda, apenas apartir da 220 --- Datamodules/acCustomSQLMainDataUn.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 3532df5..c5fa55e 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -371,11 +371,11 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); SQLConnectionMeta.Params.Values[sName] := Values[sName]; //Altera o arquivo para salvar a senha criptografada - if (UpperCase(extractfilename(application.exename)) = 'LABMASTER.EXE') or (UpperCase(extractfilename(application.exename)) = 'LABPLUS.EXE') then + {if (UpperCase(extractfilename(application.exename)) = 'LABMASTER.EXE') or (UpperCase(extractfilename(application.exename)) = 'LABPLUS.EXE') then begin Values[sName] := simpleCrypt(Values[sName]) + '=='; SaveToFile(selectParamsFileName); - end; + end;} end; FSenhaFirebird := SQLConnection.Params.Values[sName]; end From de3d72e26f1a5afe87861aa088ab3f48d3ef335c Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 18 Jan 2023 16:09:01 -0300 Subject: [PATCH 267/294] =?UTF-8?q?Ticket=5FID:=20#110358=20-=20Expiro=20d?= =?UTF-8?q?e=20senha=20do=20usu=C3=A1rio?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/RecursoDataUn.dfm | 17 +++++++++-------- Datamodules/RecursoDataUn.pas | 1 + Forms/osCustomMainFrm.pas | 8 ++++++++ 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/Datamodules/RecursoDataUn.dfm b/Datamodules/RecursoDataUn.dfm index f115b26..960d0f0 100644 --- a/Datamodules/RecursoDataUn.dfm +++ b/Datamodules/RecursoDataUn.dfm @@ -1,8 +1,6 @@ object RecursoData: TRecursoData OldCreateOrder = False OnCreate = DataModuleCreate - Left = 674 - Top = 148 Height = 491 Width = 305 object MasterDataSet: TosSQLDataSet @@ -11,7 +9,7 @@ object RecursoData: TRecursoData ' Descricao,'#13#10' FilterDefName,'#13#10' DataClassName,'#13#10' ResClassName,' + #13#10' ReportClassName,'#13#10' IndiceImagem,'#13#10' NumOrdem,'#13#10' habilitaEd' + 'itarTodos,'#13#10' forcaReExecucaoFiltro'#13#10'FROM '#13#10' Recurso'#13#10'WHERE'#13#10' ' + - 'IDRecurso=:ID'#13#10 + 'IDRecurso=:ID' MaxBlobSize = 32 Params = < item @@ -109,7 +107,7 @@ object RecursoData: TRecursoData '.IdGrupo'#13#10' INNER JOIN Recurso R'#13#10' ON D.IdRecurso = R.IdRecur' + 'so'#13#10' INNER JOIN Dominio Dom'#13#10' ON R.IdDominio = Dom.IdDominio' + #13#10'WHERE'#13#10' UPPER(U.Apelido) LIKE UPPER(:UserName)'#13#10'ORDER BY'#13#10' ' + - 'Dom.Descricao,'#13#10' R.Nome'#13#10 + 'Dom.Descricao,'#13#10' R.Nome' MaxBlobSize = 32 Params = < item @@ -131,7 +129,7 @@ object RecursoData: TRecursoData CommandText = 'select'#13#10' DESCRICAO,'#13#10' IDACAO,'#13#10' IDRECURSO,'#13#10' INDICEIMAGEM,'#13#10 + ' NOME,'#13#10' NOMECOMPONENTE'#13#10'from'#13#10' ACAO'#13#10'where'#13#10' IDRECURSO = :I' + - 'DRECURSO'#13#10 + 'DRECURSO' DataSource = MasterDataSource MaxBlobSize = 32 Params = < @@ -175,7 +173,7 @@ object RecursoData: TRecursoData 'IdGrupo = D.IdGrupo'#13#10' JOIN Recurso R'#13#10' ON D.IdRecurso = R.Id' + 'Recurso'#13#10' JOIN Acao A'#13#10' ON D.IdAcao = A.IdAcao'#13#10'WHERE'#13#10' UPP' + 'ER(U.Apelido) LIKE UPPER(:UserName)'#13#10' AND UPPER(R.Nome) = UPPER' + - '(:NomeRecurso)'#13#10 + '(:NomeRecurso)' MaxBlobSize = 32 Params = < item @@ -204,8 +202,8 @@ object RecursoData: TRecursoData end object UsuarioDataSet: TosSQLDataSet CommandText = - 'SELECT'#13#10' Apelido,'#13#10' Nome,'#13#10' Senha,'#13#10' Status'#13#10'FROM'#13#10' Usuario' + - #13#10'WHERE'#13#10' UPPER(Apelido) = UPPER(:Username)'#13#10 + 'SELECT'#13#10' Apelido,'#13#10' Nome,'#13#10' Senha,'#13#10' Status,'#13#10' DataSenha'#13#10'F' + + 'ROM'#13#10' Usuario'#13#10'WHERE'#13#10' UPPER(Apelido) = UPPER(:Username)' MaxBlobSize = 32 Params = < item @@ -234,6 +232,9 @@ object RecursoData: TRecursoData FixedChar = True Size = 1 end + object UsuarioDataSetDATASENHA: TDateField + FieldName = 'DATASENHA' + end end object UsuarioProvider: TosSQLDataSetProvider DataSet = UsuarioDataSet diff --git a/Datamodules/RecursoDataUn.pas b/Datamodules/RecursoDataUn.pas index b1e3b29..34176fc 100644 --- a/Datamodules/RecursoDataUn.pas +++ b/Datamodules/RecursoDataUn.pas @@ -42,6 +42,7 @@ TRecursoData = class(TDataModule) MasterDataSetHABILITAEDITARTODOS: TStringField; MasterDataSetFORCAREEXECUCAOFILTRO: TStringField; UsuarioDataSetSTATUS: TStringField; + UsuarioDataSetDATASENHA: TDateField; procedure DataModuleCreate(Sender: TObject); private diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index da86220..79c6908 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -201,6 +201,8 @@ TosCustomMainForm = class(TosForm) private FNewFilter: boolean; FUserName: string; + FUserDataSenha: TDateTime; + FUserSenha: string; FEditForm: TosCustomEditForm; FActionDblClick: TAction; FSelectedList: TStringListExt; @@ -265,6 +267,8 @@ TosCustomMainForm = class(TosForm) constructor Create(AOwner: TComponent); override; destructor Destroy; override; property UserName: string read FUserName; + property UserDataSenha: TDateTime read FUserDataSenha; + property UserSenha: String read FUserSenha; property ActionDblClick: TAction read FActionDblClick write SetActionDblClick; procedure ExecLastFilter; function getReportByResource(name: string; stream: TMemoryStream): boolean; @@ -1210,7 +1214,11 @@ function TosCustomMainForm.Login: boolean; Inc(ErrorCount); end else + begin LoginCorrect := True; + FUserDataSenha := cdsUsuario.FieldByName('DataSenha').AsDateTime; + FUserSenha := cdsUsuario.FieldByName('Senha').AsString; + end; finally cdsUsuario.Close; end; From 7ea6c37425beb5fc3b6730842cac70ca1f95f9c7 Mon Sep 17 00:00:00 2001 From: Claudio Date: Wed, 18 Jan 2023 17:29:17 -0300 Subject: [PATCH 268/294] =?UTF-8?q?Ticket=5FID:=20#110358=20-=20Expiro=20d?= =?UTF-8?q?e=20senha=20do=20usu=C3=A1rio?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Forms/osCustomMainFrm.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 79c6908..79e22a4 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1183,6 +1183,8 @@ function TosCustomMainForm.Login: boolean; begin FSuperUserLogged := true; LoginCorrect := True; + if LogData <> nil then + LogData.ClasseClientDataset.Filtered := False; Break; end; end; From 0ff8e8061c21bf8eb6709303374f36a66d7936e6 Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 27 Jan 2023 08:11:52 -0300 Subject: [PATCH 269/294] Alterando o metodo GetDosOutput, para escrever em tempo real em um Memo --- Lib/UtilsUnitGUI.pas | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 20ce739..2c7d568 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -53,7 +53,7 @@ function GetTaskHandle(const ATaskName : string; var FTaskName: String; var FPid var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer) : HWND; procedure ExecuteAndWait(const aCommando: string); function Execute(const aCommando: string; const ShowWindow: boolean; var aProcessInformation: TProcessInformation): boolean; -function GetDosOutput(CommandLine: string): string; +function GetDosOutput(outPut: TMemo; CommandLine: string): string; procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAlive: boolean; aThreadId: TThreadID; const aPort: integer); procedure CloseProcess(const aProcessInformation: TProcessInformation); function LocalIp: string; @@ -686,7 +686,7 @@ function Execute(const aCommando: string; const ShowWindow: boolean; var aProces SendMessage(nHwnd, WM_SYSCOMMAND, SC_MINIMIZE, 0) end; -function GetDosOutput(CommandLine: string): string; +function GetDosOutput(outPut: TMemo; CommandLine: string): String; var SA: TSecurityAttributes; SI: TStartupInfo; @@ -697,7 +697,6 @@ function GetDosOutput(CommandLine: string): string; BytesRead: Cardinal; Handle: Boolean; begin - Result := ''; with SA do begin nLength := SizeOf(SA); bInheritHandle := True; @@ -718,15 +717,18 @@ function GetDosOutput(CommandLine: string): string; Handle := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, nil, SI, PI); + Application.BringToFront; CloseHandle(StdOutPipeWrite); if Handle then try repeat WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil); - if BytesRead > 0 then + if WasOK and (BytesRead > 0) then begin Buffer[BytesRead] := #0; - Result := Result + String(Buffer); + outPut.SelStart := outPut.GetTextLen; + outPut.SelLength := 0; + outPut.SelText := Buffer; end; until not WasOK or (BytesRead = 0); WaitForSingleObject(PI.hProcess, INFINITE); From a44335d39c4d0536bb618689fd3bf4f2f26a41aa Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 2 Feb 2023 17:49:28 -0300 Subject: [PATCH 270/294] =?UTF-8?q?ticket=5Fid:=20#111072=20-=20Transporta?= =?UTF-8?q?r=20os=20arquivo=20de=20integra=C3=A7=C3=B5es=20para=20um=20ban?= =?UTF-8?q?co=20separado?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Datamodules/acCustomSQLMainDataUn.dfm | 45 +++++++++++++++++++++++++++ Datamodules/acCustomSQLMainDataUn.pas | 20 ++++++++++-- 2 files changed, 63 insertions(+), 2 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.dfm b/Datamodules/acCustomSQLMainDataUn.dfm index c4eb7d8..bdcf1c9 100644 --- a/Datamodules/acCustomSQLMainDataUn.dfm +++ b/Datamodules/acCustomSQLMainDataUn.dfm @@ -67,4 +67,49 @@ object acCustomSQLMainData: TacCustomSQLMainData Left = 100 Top = 152 end + object SQLConnectionArquivos: TSQLConnection + ConnectionName = 'IBArquivos' + DriverName = 'Firebird' + LoginPrompt = False + Params.Strings = ( + 'DriverUnit=Data.DBXFirebird' + + 'DriverPackageLoader=TDBXDynalinkDriverLoader,DbxCommonDriver180.' + + 'bpl' + + 'DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader,Borla' + + 'nd.Data.DbxCommonDriver,Version=18.0.0.0,Culture=neutral,PublicK' + + 'eyToken=91d62ebb5b0d1b1b' + + 'MetaDataPackageLoader=TDBXFirebirdMetaDataCommandFactory,DbxFire' + + 'birdDriver180.bpl' + + 'MetaDataAssemblyLoader=Borland.Data.TDBXFirebirdMetaDataCommandF' + + 'actory,Borland.Data.DbxFirebirdDriver,Version=18.0.0.0,Culture=n' + + 'eutral,PublicKeyToken=91d62ebb5b0d1b1b' + 'GetDriverFunc=getSQLDriverINTERBASE' + 'LibraryName=dbxfb.dll' + 'LibraryNameOsx=libsqlfb.dylib' + 'VendorLib=fbclient.dll' + 'VendorLibWin64=fbclient.dll' + 'VendorLibOsx=/Library/Frameworks/Firebird.framework/Firebird' + 'Database=c:\db\arquivos.fdb' + 'User_Name=sysdba' + 'Password=masterkey' + 'Role=RoleName' + 'MaxBlobSize=-1' + 'LocaleCode=0000' + 'IsolationLevel=ReadCommitted' + 'SQLDialect=3' + 'CommitRetain=False' + 'WaitOnLocks=True' + 'TrimChar=False' + 'BlobSize=-1' + 'ErrorResourceFile=' + 'RoleName=RoleName' + 'ServerCharSet=' + 'Trim Char=False') + Left = 100 + Top = 225 + end end diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 3532df5..5d61723 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -47,6 +47,7 @@ TacCustomSQLMainData = class(TDataModule) FilterQuery: TosSQLDataSet; SQLMonitor: TSQLMonitor; SQLConnectionMeta: TosSQLConnection; + SQLConnectionArquivos: TSQLConnection; procedure DataModuleCreate(Sender: TObject); private @@ -78,6 +79,7 @@ TacCustomSQLMainData = class(TDataModule) function GetNetUserName: string; function GetQuery(meta: boolean = false): TosSQLQuery; + function GetQueryArquivo: TosSQLQuery; procedure FreeQuery(Query: TosSQLQuery); function GetServerDate(aConnection: TSQLConnection=nil): TDatetime; @@ -388,8 +390,16 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); end; end; if SQLConnectionMeta.Params.Values['DataBaseMeta']<>'' then - SQLConnectionMeta.Params.Values['Database'] := - SQLConnectionMeta.Params.Values['DatabaseMeta']; + SQLConnectionMeta.Params.Values['Database'] := SQLConnectionMeta.Params.Values['DatabaseMeta']; + + //Conexão com o banco de arquivos + if FileExists(ExtractFilePath(SQLConnection.Params.Values['database']) + 'Arquivos.fdb') then + begin + SQLConnectionArquivos.Params := SQLConnection.Params; + SQLConnectionArquivos.Params.Values['database'] := ExtractFilePath(SQLConnection.Params.Values['database']) + 'Arquivos.fdb'; + SQLConnectionArquivos.Params.Values['PASSWORD'] := SQLConnection.Params.Values['PASSWORD']; + SQLConnectionArquivos.Connected := True; + end; finally Free; end; @@ -418,6 +428,12 @@ function TacCustomSQLMainData.GetQuery(meta: boolean): TosSQLQuery; Result.SQLConnection := SQLConnection; end; +function TacCustomSQLMainData.GetQueryArquivo: TosSQLQuery; +begin + Result := TosSQLQuery.Create(Self); + Result.SQLConnection := SQLConnectionArquivos; +end; + procedure TacCustomSQLMainData.FreeQuery(Query: TosSQLQuery); begin Query.Close; From c85622beb777ba8cbe011d2c0b55976af292fd4b Mon Sep 17 00:00:00 2001 From: Claudio Date: Mon, 13 Mar 2023 17:57:24 -0300 Subject: [PATCH 271/294] Ticket_ID: #111875 - adicionando form de aguarde no FW para uso no Agendador --- Forms/UMensagemAguarde.dfm | 38 ++++++++++++++++ Forms/UMensagemAguarde.pas | 88 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 126 insertions(+) create mode 100644 Forms/UMensagemAguarde.dfm create mode 100644 Forms/UMensagemAguarde.pas diff --git a/Forms/UMensagemAguarde.dfm b/Forms/UMensagemAguarde.dfm new file mode 100644 index 0000000..37d311f --- /dev/null +++ b/Forms/UMensagemAguarde.dfm @@ -0,0 +1,38 @@ +object FrmMensagemAguarde: TFrmMensagemAguarde + Left = 541 + Top = 384 + Align = alCustom + BorderStyle = bsNone + BorderWidth = 4 + ClientHeight = 48 + ClientWidth = 358 + Color = cl3DDkShadow + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = True + Position = poDesigned + OnActivate = FormActivate + PixelsPerInch = 96 + TextHeight = 13 + object MensagemPanel: TPanel + Left = 0 + Top = 0 + Width = 358 + Height = 48 + Align = alClient + BorderStyle = bsSingle + Color = clActiveBorder + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentBackground = False + ParentFont = False + TabOrder = 0 + ExplicitWidth = 381 + end +end diff --git a/Forms/UMensagemAguarde.pas b/Forms/UMensagemAguarde.pas new file mode 100644 index 0000000..ae8148e --- /dev/null +++ b/Forms/UMensagemAguarde.pas @@ -0,0 +1,88 @@ +unit UMensagemAguarde; + +interface + +uses + SysUtils, Classes, Variants, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, ComCtrls; + +type + TFrmMensagemAguarde = class(TForm) + MensagemPanel: TPanel; + procedure FormActivate(Sender: TObject); + private + procedure SetPositionScreean(ControlLock: TWinControl); + public + procedure setMensagem(Texto: String; useProcessMessages: Boolean = False); virtual; + procedure msgShow; + procedure msgClose; + procedure ShowTop(Parent : TWinControl); + function getIsCancelled: Boolean; virtual; + end; + +implementation + +{$R *.dfm} + +{ TFrmMensagemAguarde } + +procedure TFrmMensagemAguarde.FormActivate(Sender: TObject); +begin + Self.Refresh; // p/ atualizar a tela + MensagemPanel.Refresh; + Application.ProcessMessages; +end; + +function TFrmMensagemAguarde.getIsCancelled: Boolean; +begin + result := False; +end; + +procedure TFrmMensagemAguarde.msgClose; +begin + self.close; +end; + +procedure TFrmMensagemAguarde.msgShow; +begin + self.show; +end; + +procedure TFrmMensagemAguarde.setMensagem(Texto: String; useProcessMessages: Boolean = False); +var + LarguraTexto : Integer; +begin + if (Texto = '') then + Texto := 'Aguarde, Carregando...'; + MensagemPanel.Caption := Texto; + + LarguraTexto := Trunc(Self.Canvas.TextWidth('M') * (Length(Texto) * 1.2)); + if Self.Width < LarguraTexto then + Self.Width := LarguraTexto; + + if useProcessMessages then + Application.ProcessMessages; + MensagemPanel.Update; + MensagemPanel.Refresh; + Refresh; +end; + +procedure TFrmMensagemAguarde.ShowTop(Parent: TWinControl); +begin + Self.SetPositionScreean(Parent); + Self.Update +end; + +procedure TFrmMensagemAguarde.SetPositionScreean(ControlLock: TWinControl); +begin + if trunc((ControlLock.Width - self.Width) / 2) > 0 then + self.Left := trunc((ControlLock.Width - self.Width) / 2) + else + self.Left := 10; + if trunc((ControlLock.Height - self.Height) / 25) > 0 then + self.Top := trunc((ControlLock.Height - self.Height) / 2) + else + self.Top := 25; +end; + +end. From f75738610b98753a3d286fb9f82aa543e4316e40 Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 22 Mar 2023 09:29:34 -0300 Subject: [PATCH 272/294] Adicionando tratamento de erro no Delete do Dataset, evitar deadlock --- Forms/osCustomEditFrm.dfm | 4 ++-- Forms/osCustomEditFrm.pas | 19 +++++++++++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/Forms/osCustomEditFrm.dfm b/Forms/osCustomEditFrm.dfm index 3397fd9..3f0516a 100644 --- a/Forms/osCustomEditFrm.dfm +++ b/Forms/osCustomEditFrm.dfm @@ -8,7 +8,7 @@ inherited osCustomEditForm: TosCustomEditForm OldCreateOrder = True OnCloseQuery = FormCloseQuery ExplicitWidth = 502 - ExplicitHeight = 355 + ExplicitHeight = 356 PixelsPerInch = 96 TextHeight = 13 object MainControlBar: TControlBar [0] @@ -168,7 +168,7 @@ inherited osCustomEditForm: TosCustomEditForm Left = 216 Top = 40 Bitmap = { - 494C010101000400100010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010101000500040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000001000000001002000000000000010 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 8024194..deea34e 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -72,6 +72,7 @@ TosCustomEditForm = class(TosForm) procedure SetExternalCDS(const Value: TosClientDataset); procedure SetDatamodule(const Value: TDatamodule); function GetKeyValues: Variant; + protected FMasterDataset: TosClientDataset; FKeyValues: variant; @@ -87,6 +88,7 @@ TosCustomEditForm = class(TosForm) procedure ChangeColor(PReadOnly: boolean); procedure ReconcileError(DataSet: TCustomClientDataSet; E: EReconcileError; UpdateKind: TUpdateKind; var Action: TReconcileAction); + procedure DeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction); public continue: boolean; constructor Create(AOwner: TComponent); override; @@ -507,6 +509,20 @@ procedure TosCustomEditForm.ReconcileError(DataSet: TCustomClientDataSet; end; end; +procedure TosCustomEditForm.DeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction); +begin + if Pos( 'deadlock', LowerCase(E.message)) > 0 then + begin + ShowMessage('Esse registro esta sendo atualizado (sincronizado) pelo Híbrido ou outro usuário, salve novamente e verifique se as alterações foram aplicadas corretamente'); + Action := daRetry; + end + else + begin + ShowMessage('Erro no Delete do clientDataSet com a mensagem: ' + quotedStr(E.message)); + Action := daRetry; + end; +end; + procedure TosCustomEditForm.FormCreate(Sender: TObject); var i: integer; @@ -515,7 +531,10 @@ procedure TosCustomEditForm.FormCreate(Sender: TObject); for i := 0 to ComponentCount-1 do begin if Components[i] is TClientDataSet then + begin (Components[i] as TClientDataSet).onReconcileError := ReconcileError; + (Components[i] as TClientDataSet).OnDeleteError := DeleteError; + end; end; end; From 1f48816cd7616ca9fc5210fe587ac6e08547d33e Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 23 Mar 2023 17:59:19 -0300 Subject: [PATCH 273/294] ticket_id: #112101 - tentativa para quando der erro de dead lock ao excluir um registro, tente mais uma vez, isso acontece no uso do hibrido --- Forms/osCustomEditFrm.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index deea34e..a9687c3 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -514,11 +514,13 @@ procedure TosCustomEditForm.DeleteError(DataSet: TDataSet; E: EDatabaseError; va if Pos( 'deadlock', LowerCase(E.message)) > 0 then begin ShowMessage('Esse registro esta sendo atualizado (sincronizado) pelo Híbrido ou outro usuário, salve novamente e verifique se as alterações foram aplicadas corretamente'); + Sleep(2000); Action := daRetry; end else begin ShowMessage('Erro no Delete do clientDataSet com a mensagem: ' + quotedStr(E.message)); + Sleep(2000); Action := daRetry; end; end; From caf93946d106b8d67eeb62345d963a3ca4841ada Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 22 May 2023 15:12:51 -0300 Subject: [PATCH 274/294] Removendo Warnings --- Lib/UtilsUnitGUI.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 2c7d568..556bbc3 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -728,7 +728,7 @@ function GetDosOutput(outPut: TMemo; CommandLine: string): String; Buffer[BytesRead] := #0; outPut.SelStart := outPut.GetTextLen; outPut.SelLength := 0; - outPut.SelText := Buffer; + outPut.SelText := String(Buffer); end; until not WasOK or (BytesRead = 0); WaitForSingleObject(PI.hProcess, INFINITE); From ebd57dac3d2da6e77d59772458c75ef3b184e40b Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 22 May 2023 15:13:05 -0300 Subject: [PATCH 275/294] ticket_id: #113334 - Alterando querys para serem compativeis com o firebird 4.0 --- Datamodules/acCustomSQLMainDataUn.pas | 2 +- Lib/UtilsUnit.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index c5fa55e..e07b488 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -484,7 +484,7 @@ function TacCustomSQLMainData.GetServerDatetime(aConnection: TSQLConnection=nil) Query.SQLConnection := aConnection; try - Query.SQL.Add('select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'); + Query.SQL.Add('select LOCALTIMESTAMP as DataHoraServidor from RDB$DATABASE'); Query.Open; Result := Query.Fields[0].AsDatetime; Query.Close; diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 167eacd..9fe3bfb 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -744,7 +744,7 @@ function GetDateTime(conn: TSQLConnection): TDateTime; try qry := TosSQLQuery.Create(nil); qry.SQLConnection := conn; - qry.SQL.Text := 'select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'; + qry.SQL.Text := 'select LOCALTIMESTAMP as DataHoraServidor from RDB$DATABASE'; qry.Open; Result := qry.FieldByName('DataHoraServidor').AsDatetime; finally From cbf2f2ab1f1bf41797a275520a889fccffb3fef1 Mon Sep 17 00:00:00 2001 From: Claudio Date: Mon, 22 May 2023 15:23:54 -0300 Subject: [PATCH 276/294] =?UTF-8?q?Ticket=5FID:=20#113345=20-=20Configuran?= =?UTF-8?q?do=20pontos=20que=20usam=20idHHTP=20para=20permitirem=20qualque?= =?UTF-8?q?r=20vers=C3=A3o=20de=20SSL?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Lib/UtilsUnit.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 167eacd..059c517 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -4,7 +4,7 @@ interface uses {$IFDEF VER250}IBServices,{$ENDIF}{$IFDEF VER320}IBX.IBServices,{$ENDIF} - INIFiles, System.Zip, System.IOUtils, StrUtils, + INIFiles, System.Zip, System.IOUtils, StrUtils, IdSSLOpenSSL, Classes, Math, RegExpr, DB, DBClient, Winapi.PsApi, osSQLConnection, osSQLQuery, WinSock, Soap.EncdDecd, Vcl.Imaging.PngImage, Vcl.Imaging.Jpeg, TlHelp32, Vcl.Imaging.GifImg, WinSpool, Winapi.Windows, System.SysUtils, IdHashSHA, @@ -21,9 +21,10 @@ THSHash = class class function GeraHashPCMed(linha: string): string; end; -const - sMODELOMSGLOG = #13+#13+'Campo %s alterado.'+#13+'De: %s'+#13+'Para: %s'; +const + sMODELOMSGLOG = #13+#13+'Campo %s alterado.'+#13+'De: %s'+#13+'Para: %s'; szChar = SizeOf(Char); + AllSSLVersions = [sslvSSLv2, sslvSSLv23, sslvSSLv3, sslvTLSv1,sslvTLSv1_1,sslvTLSv1_2]; function isDigitOrControl(Key: char): boolean; function RemoveAcento(Str:String): String; @@ -143,7 +144,7 @@ function GetJsonValue(jsonObject: TJsonObject; campo: string): string; implementation -uses DateUtils, Variants, StatusUnit, IdSSLOpenSSL, IdMultipartFormData, IdExceptionCore, IdStack, +uses DateUtils, Variants, StatusUnit, IdMultipartFormData, IdExceptionCore, IdStack, IdHash, IdHashMessageDigest, IdGlobal, IdURI, ParametroSistemaDataUn; @@ -2150,7 +2151,7 @@ function getJsonStringFromServer(const aURL: string; var aException: string): st IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(_http); IOHandler.SSLOptions.Method := sslvSSLv23; IOHandler.SSLOptions.Mode := sslmUnassigned; - IOHandler.SSLOptions.SSLVersions := [sslvSSLv2,sslvSSLv3,sslvTLSv1,sslvTLSv1_1,sslvTLSv1_2]; + IOHandler.SSLOptions.SSLVersions := AllSSLVersions; _http.IOHandler := IOHandler; end; try From e1046d802af6a279404f8f56207bf68493b3a2db Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 23 May 2023 09:38:18 -0300 Subject: [PATCH 277/294] Revert "ticket_id: #113334 - Alterando querys para serem compativeis com o firebird 4.0" This reverts commit ebd57dac3d2da6e77d59772458c75ef3b184e40b. --- Datamodules/acCustomSQLMainDataUn.pas | 2 +- Lib/UtilsUnit.pas | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index e07b488..c5fa55e 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -484,7 +484,7 @@ function TacCustomSQLMainData.GetServerDatetime(aConnection: TSQLConnection=nil) Query.SQLConnection := aConnection; try - Query.SQL.Add('select LOCALTIMESTAMP as DataHoraServidor from RDB$DATABASE'); + Query.SQL.Add('select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'); Query.Open; Result := Query.Fields[0].AsDatetime; Query.Close; diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index a583e04..059c517 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -745,7 +745,7 @@ function GetDateTime(conn: TSQLConnection): TDateTime; try qry := TosSQLQuery.Create(nil); qry.SQLConnection := conn; - qry.SQL.Text := 'select LOCALTIMESTAMP as DataHoraServidor from RDB$DATABASE'; + qry.SQL.Text := 'select CURRENT_TIMESTAMP as DataHoraServidor from RDB$DATABASE'; qry.Open; Result := qry.FieldByName('DataHoraServidor').AsDatetime; finally From 6e54b2eedda4d902bedc02ff92799518b3edb66f Mon Sep 17 00:00:00 2001 From: Francisco Date: Mon, 5 Jun 2023 09:28:03 -0300 Subject: [PATCH 278/294] ticket_id: #113372 - melhorias no agendador e correcoes de memory leak --- Lib/UtilsUnit.pas | 37 +++++++++++++++-------------- Lib/UtilsUnitGUI.pas | 55 ++++++++++++++++++++++++++------------------ 2 files changed, 53 insertions(+), 39 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 059c517..d329d86 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1391,8 +1391,8 @@ function TestConnection(const url: String; conn: TosSQLConnection = nil): boolea end; finally Stream.Free; - LHandler.Free; - HTTPClient.Free; + FreeAndNil(LHandler); + FreeAndNil(HTTPClient); FreeAndNil(ParametroSistema); end; end; @@ -1825,21 +1825,24 @@ function KillTask(const ExeFileName: string): Integer; begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); - FProcessEntry32.dwSize := SizeOf(FProcessEntry32); - ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); - while Integer(ContinueLoop) <> 0 do - begin - if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = - UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = - UpperCase(ExeFileName))) then - Result := Integer(TerminateProcess( - OpenProcess(PROCESS_TERMINATE, - BOOL(0), - FProcessEntry32.th32ProcessID), - 0)); - ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); - end; - CloseHandle(FSnapshotHandle); + try + FProcessEntry32.dwSize := SizeOf(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = + UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = + UpperCase(ExeFileName))) then + Result := Integer(TerminateProcess( + OpenProcess(PROCESS_TERMINATE, + BOOL(0), + FProcessEntry32.th32ProcessID), + 0)); + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + finally + CloseHandle(FSnapshotHandle); + end; end; function GetMD5FromString(const text: string): String; diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 556bbc3..82aff8d 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -565,9 +565,9 @@ function dgCreateProcess(const FileName: string; SleepInterval: integer = 10000) nil, nil, StartInfo, ProcInfo); + finally CloseHandle(ProcInfo.hProcess); CloseHandle(ProcInfo.hThread); - finally SleepEx(SleepInterval, False); FrmMensagem.Close; FrmMensagem.Release; @@ -634,20 +634,23 @@ procedure ExecuteAndWait(const aCommando: string); wShowWindow := SW_HIDE; end; - if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, - nil, nil, tmpStartupInfo, tmpProcessInformation) then - begin - // loop every 10 ms - while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do + try + if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW, + nil, nil, tmpStartupInfo, tmpProcessInformation) then begin - Application.ProcessMessages; + // loop every 10 ms + while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do + begin + Application.ProcessMessages; + end; + end + else + begin + RaiseLastOSError; end; + finally CloseHandle(tmpProcessInformation.hProcess); CloseHandle(tmpProcessInformation.hThread); - end - else - begin - RaiseLastOSError; end; end; @@ -737,7 +740,10 @@ function GetDosOutput(outPut: TMemo; CommandLine: string): String; CloseHandle(PI.hProcess); end; finally - CloseHandle(StdOutPipeRead); + if StdOutPipeRead > 0 then + CloseHandle(StdOutPipeRead); + if StdOutPipeWrite > 0 then + CloseHandle(StdOutPipeWrite); end; end; @@ -812,8 +818,8 @@ procedure WaitProcess(const aProcessInformation: TProcessInformation; aCheckIsAl procedure CloseProcess(const aProcessInformation: TProcessInformation); begin - CloseHandle(aProcessInformation.hProcess); - CloseHandle(aProcessInformation.hThread); + GlobalFree(aProcessInformation.hProcess); + GlobalFree(aProcessInformation.hThread); end; function GetSystemInfo: string; @@ -882,14 +888,19 @@ function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FP dwResult := nil; try AppHandle:= UtilsUnitGui.GetTaskHandle(Aplicacao, FTaskName, FPid, FProcessa, FHWND, iListOfProcess); - if AppHandle <> 0 then - begin - ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, - SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); - if ValorRetorno > 0 then - Result := True - else - Result := False; + try + if AppHandle <> 0 then + begin + ValorRetorno:= SendMessageTimeout(AppHandle, WM_NULL, 0, 0, + SMTO_ABORTIFHUNG OR SMTO_BLOCK, 1000, dwResult); + if ValorRetorno > 0 then + Result := True + else + Result := False; + end; + finally + if AppHandle > 0 then + CloseHandle(AppHandle); end; except end; From 656ecf5dbac985d09a5620ce7e5df58fc3e05d5e Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 6 Jun 2023 11:17:50 -0300 Subject: [PATCH 279/294] ticket_id: #113372 - melhorias no agendador e correcoes de memory leak --- Lib/UtilsUnit.pas | 37 +++++++++++++++++-------------------- 1 file changed, 17 insertions(+), 20 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index d329d86..059c517 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1391,8 +1391,8 @@ function TestConnection(const url: String; conn: TosSQLConnection = nil): boolea end; finally Stream.Free; - FreeAndNil(LHandler); - FreeAndNil(HTTPClient); + LHandler.Free; + HTTPClient.Free; FreeAndNil(ParametroSistema); end; end; @@ -1825,24 +1825,21 @@ function KillTask(const ExeFileName: string): Integer; begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); - try - FProcessEntry32.dwSize := SizeOf(FProcessEntry32); - ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); - while Integer(ContinueLoop) <> 0 do - begin - if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = - UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = - UpperCase(ExeFileName))) then - Result := Integer(TerminateProcess( - OpenProcess(PROCESS_TERMINATE, - BOOL(0), - FProcessEntry32.th32ProcessID), - 0)); - ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); - end; - finally - CloseHandle(FSnapshotHandle); - end; + FProcessEntry32.dwSize := SizeOf(FProcessEntry32); + ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); + while Integer(ContinueLoop) <> 0 do + begin + if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = + UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = + UpperCase(ExeFileName))) then + Result := Integer(TerminateProcess( + OpenProcess(PROCESS_TERMINATE, + BOOL(0), + FProcessEntry32.th32ProcessID), + 0)); + ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); + end; + CloseHandle(FSnapshotHandle); end; function GetMD5FromString(const text: string): String; From 17137e7860228e161d1fe9907190835f42f741db Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 12 Jul 2023 15:53:47 -0300 Subject: [PATCH 280/294] Adicionando o SSL ao componente de conexao http --- Lib/UtilsUnit.pas | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 059c517..5561533 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1338,6 +1338,9 @@ function TestConnection(const url: String; conn: TosSQLConnection = nil): boolea HTTPClient := TidHTTP.Create(nil); LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTPClient); + LHandler.SSLOptions.Method := sslvSSLv23; + LHandler.SSLOptions.Mode := sslmUnassigned; + LHandler.SSLOptions.SSLVersions := AllSSLVersions; HTTPClient.IOHandler := LHandler; HTTPClient.HandleRedirects := True; HTTPClient.AllowCookies := True; From a2c95525eda8b736b99f0bf4e371f2e12dca976a Mon Sep 17 00:00:00 2001 From: Francisco Date: Wed, 19 Jul 2023 17:42:13 -0300 Subject: [PATCH 281/294] ticket_id: #112352 - aviso de troca de senha necessaria ao usar recursos que precisam de login --- Lib/osLogin.pas | 72 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 68 insertions(+), 4 deletions(-) diff --git a/Lib/osLogin.pas b/Lib/osLogin.pas index 4ef3de6..ebc87a8 100644 --- a/Lib/osLogin.pas +++ b/Lib/osLogin.pas @@ -14,9 +14,14 @@ TLoginUsuario = class FIDUsuario: integer; FStatus: string; FApelido: string; + FUserDataSenha: TDateTime; + FUserSenha: string; + function GetSystemUserName: string; function isGrupo(nomeColuna: string; caption: string): boolean; + function SenhaExpirada: Boolean; public + constructor create; property IDUsuario: integer read FIDUsuario; property Apelido: string read FApelido; property Nome: string read FNome; @@ -28,12 +33,15 @@ TLoginUsuario = class procedure Logout; function isTesoureiro: boolean; function isCaixa: boolean; - constructor create; + property UserName: string read FNome; + property UserDataSenha: TDateTime read FUserDataSenha; + property UserSenha: String read FUserSenha; + procedure ValidaSenhaExpirada; end; implementation -uses DB, osMD5, StatusUnit; +uses DB, osMD5, StatusUnit, osSQLQuery, SQLMainData, ParametroSistemaDataUn, LogDataUn, LMLogCodes, MudarSenhaFormUn; constructor TLoginUsuario.create; begin @@ -151,7 +159,7 @@ function TLoginUsuario.Login(caption: string; and (mrCancel <> LoginForm.ShowModal) do begin query.SQLConnection := acCustomSQLMainData.SQLConnection; - query.CommandText := 'SELECT idusuario, apelido, nome, senha, status FROM USUARIO' + + query.CommandText := 'SELECT idusuario, apelido, nome, senha, status, DataSenha FROM USUARIO' + ' WHERE lower(apelido) = ' + quotedStr(LowerCase(LoginForm.UsernameEdit.Text)); query.Open; try @@ -175,10 +183,14 @@ function TLoginUsuario.Login(caption: string; end else begin + self.ValidaSenhaExpirada; + FIDUsuario := query.fieldByName('IDUsuario').AsInteger; FApelido := query.fieldByName('Apelido').AsString; FNome := query.fieldByName('Nome').AsString; FStatus := query.fieldByName('Status').AsString; + FUserDataSenha := query.FieldByName('DataSenha').AsDateTime; + FUserSenha := query.FieldByName('Senha').AsString; LoginCorrect := True; end; finally @@ -203,5 +215,57 @@ procedure TLoginUsuario.Logout; FIDUsuario := -1; end; +procedure TLoginUsuario.ValidaSenhaExpirada; +var + Oldpassword : string; + Newpassword : string; + cancelouTrocaSenha: Boolean; + msglog: string; + qryUsuario: TosSQLQuery; +begin + if SenhaExpirada then + begin + cancelouTrocaSenha := False; + if MessageDlg('Sua senha expirou e precisa ser alterada.'+#13+ + 'Deseja trocar a senha agora?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then + begin + cancelouTrocaSenha := True; + end + else + begin + Oldpassword := FUserSenha; + Newpassword := TMudarSenhaForm.Execute(FUserSenha); + + if Newpassword = Oldpassword then + cancelouTrocaSenha := True + else + begin + qryUsuario := MainData.GetQuery; + try + qryUsuario.SQL.Text := 'update usuario set senha = :senha, datasenha = :datasenha where idusuario = :idusuario'; + qryUsuario.ParamByName('senha').AsString := Newpassword; + qryUsuario.ParamByName('datasenha').AsDate := MainData.GetServerDate; + qryUsuario.ParamByName('idusuario').AsInteger := MainData.IDUsuario; + qryUsuario.ExecSQL; + finally + FreeAndNil(qryUsuario); + end; + end; + end; + if cancelouTrocaSenha then + begin + msglog := 'Usuario ' + FNome + ' cancelou a troca da senha expirada.'; + LogData.Logar(CL_ParametrosSistema, SCL_ParametroSistemaSenha, msglog); + end; + end; +end; + +function TLoginUsuario.SenhaExpirada: Boolean; +begin + Result := False; + if ParametroSistemaData.ExpiroSenha <> 0 then + Result := (FUserDataSenha + ParametroSistemaData.ExpiroSenha) < MainData.GetServerDatetime; +end; + end. - + From 39b1560451bca40bcbb1e40bc99ee7c8ec9d2aa1 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 20 Jul 2023 10:24:14 -0300 Subject: [PATCH 282/294] ticket_id: #112352 - aviso de troca de senha necessaria ao usar recursos que precisam de login --- Lib/osLogin.pas | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Lib/osLogin.pas b/Lib/osLogin.pas index ebc87a8..19eb343 100644 --- a/Lib/osLogin.pas +++ b/Lib/osLogin.pas @@ -183,8 +183,6 @@ function TLoginUsuario.Login(caption: string; end else begin - self.ValidaSenhaExpirada; - FIDUsuario := query.fieldByName('IDUsuario').AsInteger; FApelido := query.fieldByName('Apelido').AsString; FNome := query.fieldByName('Nome').AsString; @@ -192,6 +190,7 @@ function TLoginUsuario.Login(caption: string; FUserDataSenha := query.FieldByName('DataSenha').AsDateTime; FUserSenha := query.FieldByName('Senha').AsString; LoginCorrect := True; + self.ValidaSenhaExpirada; end; finally query.Close; From 4b0a158f8fd5664c6f1ebf9e6b7511dcdd991aff Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 28 Jul 2023 09:36:11 -0300 Subject: [PATCH 283/294] ticket_id: #114664 #112350 - criptografia de senha no appparams (backup) --- Forms/osCustomMainFrm.pas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 79e22a4..67c9ba6 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -287,7 +287,7 @@ implementation uses acCustomSQLMainDataUn, FilterDefEditFormUn, RecursoDataUn, osReportUtils, UtilsUnit, Types, TerminalConsultaFormUn, UMensagemAguarde, StatusUnit, - ParametroSistemaDataUn, LogDataUn; + ParametroSistemaDataUn, LogDataUn, acSysUtils, acStrUtils; {$R *.DFM} @@ -339,10 +339,12 @@ constructor TosCustomMainForm.Create(AOwner: TComponent); begin sName := Names[i]; SQLConnection.Params.Values[sName] := Values[sName]; + if UpperCase(sName) = 'PASSWORD' then + if Copy(Values[sName], Values[sName].Length - 1, 2) = '==' then + SQLConnection.Params.Values[sName] := simpleDecrypt(Copy(Values[sName], 1, Values[sName].Length - 1)); end; if SQLConnection.Params.Values['DataBaseMeta']<>'' then - SQLConnection.Params.Values['Database'] := - SQLConnection.Params.Values['DatabaseMeta']; + SQLConnection.Params.Values['Database'] := SQLConnection.Params.Values['DatabaseMeta']; finally Free; end; From 39f9db050fe99ac14813e3fc60353fdcf3bfac8f Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 4 Aug 2023 11:03:09 -0300 Subject: [PATCH 284/294] ticket_id: #112352 - aviso da troca de senha expirada --- Lib/osLogin.pas | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/Lib/osLogin.pas b/Lib/osLogin.pas index 19eb343..1f26167 100644 --- a/Lib/osLogin.pas +++ b/Lib/osLogin.pas @@ -41,7 +41,7 @@ TLoginUsuario = class implementation -uses DB, osMD5, StatusUnit, osSQLQuery, SQLMainData, ParametroSistemaDataUn, LogDataUn, LMLogCodes, MudarSenhaFormUn; +uses DB, osMD5, StatusUnit, osSQLQuery, ParametroSistemaDataUn, SQLMainData, LogDataUn, LMLogCodes, MudarSenhaFormUn; constructor TLoginUsuario.create; begin @@ -244,7 +244,7 @@ procedure TLoginUsuario.ValidaSenhaExpirada; qryUsuario.SQL.Text := 'update usuario set senha = :senha, datasenha = :datasenha where idusuario = :idusuario'; qryUsuario.ParamByName('senha').AsString := Newpassword; qryUsuario.ParamByName('datasenha').AsDate := MainData.GetServerDate; - qryUsuario.ParamByName('idusuario').AsInteger := MainData.IDUsuario; + qryUsuario.ParamByName('idusuario').AsInteger := FIDUsuario; qryUsuario.ExecSQL; finally FreeAndNil(qryUsuario); @@ -260,11 +260,24 @@ procedure TLoginUsuario.ValidaSenhaExpirada; end; function TLoginUsuario.SenhaExpirada: Boolean; +var + query: TosSQLDataSet; begin Result := False; - if ParametroSistemaData.ExpiroSenha <> 0 then - Result := (FUserDataSenha + ParametroSistemaData.ExpiroSenha) < MainData.GetServerDatetime; + query := TosSQLDataSet.Create(nil); + try + query.SQLConnection := acCustomSQLMainData.SQLConnection; + query.commandText := 'SELECT expirosenha from parametrosistema'; + query.Open; + + if query.FieldByName('ExpiroSenha').AsInteger <> 0 then + Result := (FUserDataSenha + query.FieldByName('ExpiroSenha').AsInteger) < MainData.GetServerDatetime; + + finally + FreeAndNil(query); + end; end; + end. From 969765780a0067ac3f2d961a11f3c490be288165 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 5 Sep 2023 14:09:58 -0300 Subject: [PATCH 285/294] correcao 220, banco de dados de arquivos --- Datamodules/acCustomSQLMainDataUn.pas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Datamodules/acCustomSQLMainDataUn.pas b/Datamodules/acCustomSQLMainDataUn.pas index 5d61723..aac26ae 100644 --- a/Datamodules/acCustomSQLMainDataUn.pas +++ b/Datamodules/acCustomSQLMainDataUn.pas @@ -393,12 +393,13 @@ procedure TacCustomSQLMainData.DataModuleCreate(Sender: TObject); SQLConnectionMeta.Params.Values['Database'] := SQLConnectionMeta.Params.Values['DatabaseMeta']; //Conexão com o banco de arquivos - if FileExists(ExtractFilePath(SQLConnection.Params.Values['database']) + 'Arquivos.fdb') then - begin + try SQLConnectionArquivos.Params := SQLConnection.Params; SQLConnectionArquivos.Params.Values['database'] := ExtractFilePath(SQLConnection.Params.Values['database']) + 'Arquivos.fdb'; SQLConnectionArquivos.Params.Values['PASSWORD'] := SQLConnection.Params.Values['PASSWORD']; SQLConnectionArquivos.Connected := True; + except + // end; finally Free; From 040775cb5f2218881f92436bd9979f114a941d38 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 21 Sep 2023 17:05:24 -0300 Subject: [PATCH 286/294] log Auditoria --- Forms/osCustomEditFrm.dfm | 25 ++++++++++++--- Forms/osCustomEditFrm.pas | 67 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 86 insertions(+), 6 deletions(-) diff --git a/Forms/osCustomEditFrm.dfm b/Forms/osCustomEditFrm.dfm index 3f0516a..70f8dd2 100644 --- a/Forms/osCustomEditFrm.dfm +++ b/Forms/osCustomEditFrm.dfm @@ -3,18 +3,20 @@ inherited osCustomEditForm: TosCustomEditForm Top = 351 Caption = 'osCustomEditForm' ClientHeight = 297 - ClientWidth = 486 + ClientWidth = 538 + KeyPreview = True Menu = MainMenu OldCreateOrder = True OnCloseQuery = FormCloseQuery - ExplicitWidth = 502 + OnKeyDown = FormKeyDown + ExplicitWidth = 554 ExplicitHeight = 356 PixelsPerInch = 96 TextHeight = 13 object MainControlBar: TControlBar [0] Left = 0 Top = 0 - Width = 486 + Width = 538 Height = 30 Align = alTop AutoDrag = False @@ -23,7 +25,7 @@ inherited osCustomEditForm: TosCustomEditForm object ControlBarPanel: TPanel Left = 11 Top = 2 - Width = 358 + Width = 362 Height = 22 Align = alLeft Alignment = taLeftJustify @@ -81,7 +83,7 @@ inherited osCustomEditForm: TosCustomEditForm end object PararButton: TSpeedButton Tag = 4 - Left = 300 + Left = 304 Top = 0 Width = 58 Height = 22 @@ -91,6 +93,19 @@ inherited osCustomEditForm: TosCustomEditForm OnClick = PararButtonClick end end + object LogsAuditoriaButton: TButton + AlignWithMargins = True + Left = 386 + Top = 2 + Width = 146 + Height = 22 + Cursor = crHelp + Align = alRight + Caption = 'Logs de Auditoria' + TabOrder = 1 + Visible = False + OnClick = LogsAuditoriaButtonClick + end end inherited ActionList: TosActionList Left = 184 diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index a9687c3..4646eb0 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -9,7 +9,7 @@ interface ToolWin, ExtCtrls, osActionList, osClientDataset, provider, osUtils, Grids, Wwdbigrd, Wwdbgrid, wwdbdatetimepicker, wwrcdpnl, Mask, wwdbedit, wwriched, osComboSearch, osDBDualTree, wwDBSpin, wwDBNavigator, wwDBcomb, wwDBlook, DBGrids, - System.Actions, System.UITypes; + System.Actions, System.UITypes, LogsAuditoriaFormUn; type TFormMode = (fmEdit, fmInsert, fmView, fmDelete); @@ -52,6 +52,7 @@ TosCustomEditForm = class(TosForm) ExcluirButton: TSpeedButton; FecharButton: TSpeedButton; PararButton: TSpeedButton; + LogsAuditoriaButton: TButton; procedure FormShow(Sender: TObject); procedure SaveActionExecute(Sender: TObject); procedure SaveCloseActionExecute(Sender: TObject); @@ -65,13 +66,17 @@ TosCustomEditForm = class(TosForm) procedure FormCreate(Sender: TObject); procedure PararButtonClick(Sender: TObject); procedure MasterDataSourceDataChange(Sender: TObject; Field: TField); + procedure LogsAuditoriaButtonClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FDatamodule: TDatamodule; FInitialControl: TWinControl; FVisibleButtons: TVisibleButtons; + FLogsAuditoria: TLogsAuditoriaForm; procedure SetExternalCDS(const Value: TosClientDataset); procedure SetDatamodule(const Value: TDatamodule); function GetKeyValues: Variant; + function GetPrimaryKeyField: TField; protected FMasterDataset: TosClientDataset; @@ -79,6 +84,9 @@ TosCustomEditForm = class(TosForm) FFormMode: TFormMode; FExternalCDS: TosClientDataset; FIsModified: boolean; + FIdGenericoLog: Integer; + FIdClasseLog: Integer; + FNumProtocoloLog: string; procedure ControlButtons; procedure MasterDatasetAfterEdit(DataSet: TDataSet); virtual; procedure CheckMasterDataset; @@ -325,6 +333,50 @@ procedure TosCustomEditForm.Loaded; FInitialControl := ActiveControl; end; +procedure TosCustomEditForm.LogsAuditoriaButtonClick(Sender: TObject); +var + lPoint: TPoint; +begin + inherited; + lPoint := LogsAuditoriaButton.ClientToScreen(Point(0,0)); + + FLogsAuditoria := TLogsAuditoriaForm.Create(self); + try + if FIdGenericoLog = 0 then + FLogsAuditoria.FIdRegistro := FMasterDataset.FieldByName(self.GetPrimaryKeyField.FieldName).AsInteger + else + FLogsAuditoria.FIdRegistro := FIdGenericoLog; + FLogsAuditoria.FIdClasseLog := FIdClasseLog; + FLogsAuditoria.FNumProtocoloLog := FNumProtocoloLog; + FLogsAuditoria.Top := lPoint.Y + LogsAuditoriaButton.Height + 2; + FLogsAuditoria.ShowModal; + finally + FreeAndNil(FLogsAuditoria); + end; +end; + +function TosCustomEditForm.GetPrimaryKeyField: TField; +var + I: Integer; +begin + Result := nil; + + // Verifique se o ClientDataSet está vazio + if not FMasterDataset.Active or FMasterDataset.IsEmpty then + Exit; + + // Percorra os campos do ClientDataSet + for I := 0 to FMasterDataset.FieldCount - 1 do + begin + // Verifique se o campo é uma chave primária + if pfInKey in FMasterDataset.Fields[I].ProviderFlags then + begin + Result := FMasterDataset.Fields[I]; + Break; // Saia do loop quando encontrar a primeira chave primária + end; + end; +end; + procedure TosCustomEditForm.CheckMasterDataset; begin if not Assigned(FMasterDataset) then @@ -384,6 +436,9 @@ procedure TosCustomEditForm.FormCloseQuery(Sender: TObject; inherited; if FormMode <> fmView then CheckChanges; + + if FLogsAuditoria <> nil then + FreeAndNil(FLogsAuditoria); end; procedure TosCustomEditForm.NewActionExecute(Sender: TObject); @@ -530,6 +585,9 @@ procedure TosCustomEditForm.FormCreate(Sender: TObject); i: integer; begin inherited; + FIdGenericoLog := 0; + FIdClasseLog := 0; + FNumProtocoloLog := ''; for i := 0 to ComponentCount-1 do begin if Components[i] is TClientDataSet then @@ -541,6 +599,13 @@ procedure TosCustomEditForm.FormCreate(Sender: TObject); end; +procedure TosCustomEditForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + inherited; + if (Shift = [ssCtrl, ssShift]) and (Key = vkL) then + LogsAuditoriaButton.Click; +end; + function TosCustomEditForm.canInsert: boolean; begin Result := true; From 5604aac1e3fdf4151104f835bba7ec6a32df7e88 Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 26 Sep 2023 10:11:24 -0300 Subject: [PATCH 287/294] log auditoria --- Forms/osCustomEditFrm.pas | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/Forms/osCustomEditFrm.pas b/Forms/osCustomEditFrm.pas index 4646eb0..534aee4 100644 --- a/Forms/osCustomEditFrm.pas +++ b/Forms/osCustomEditFrm.pas @@ -121,7 +121,7 @@ TosCustomEditFormClass = class of TosCustomEditForm; implementation -uses TradutorFormUn; +uses TradutorFormUn, osLogin; {$R *.DFM} @@ -336,22 +336,32 @@ procedure TosCustomEditForm.Loaded; procedure TosCustomEditForm.LogsAuditoriaButtonClick(Sender: TObject); var lPoint: TPoint; + loginForm: TLoginUsuario; begin inherited; - lPoint := LogsAuditoriaButton.ClientToScreen(Point(0,0)); - - FLogsAuditoria := TLogsAuditoriaForm.Create(self); + loginForm := TLoginUsuario.Create; try - if FIdGenericoLog = 0 then - FLogsAuditoria.FIdRegistro := FMasterDataset.FieldByName(self.GetPrimaryKeyField.FieldName).AsInteger - else - FLogsAuditoria.FIdRegistro := FIdGenericoLog; - FLogsAuditoria.FIdClasseLog := FIdClasseLog; - FLogsAuditoria.FNumProtocoloLog := FNumProtocoloLog; - FLogsAuditoria.Top := lPoint.Y + LogsAuditoriaButton.Height + 2; - FLogsAuditoria.ShowModal; + loginForm.getInfoUsuarioLogadoSistema; + if UpperCase(loginForm.Apelido) = 'SUPORTE' then + begin + lPoint := LogsAuditoriaButton.ClientToScreen(Point(0,0)); + + FLogsAuditoria := TLogsAuditoriaForm.Create(self); + try + if FIdGenericoLog = 0 then + FLogsAuditoria.FIdRegistro := FMasterDataset.FieldByName(self.GetPrimaryKeyField.FieldName).AsInteger + else + FLogsAuditoria.FIdRegistro := FIdGenericoLog; + FLogsAuditoria.FIdClasseLog := FIdClasseLog; + FLogsAuditoria.FNumProtocoloLog := FNumProtocoloLog; + FLogsAuditoria.Top := lPoint.Y + LogsAuditoriaButton.Height + 2; + FLogsAuditoria.ShowModal; + finally + FreeAndNil(FLogsAuditoria); + end; + end; finally - FreeAndNil(FLogsAuditoria); + FreeAndNil(loginForm); end; end; From 7637705196c8302c9f368b46cf2d79d368f7956c Mon Sep 17 00:00:00 2001 From: Francisco Date: Tue, 12 Dec 2023 09:35:58 -0300 Subject: [PATCH 288/294] ticket_id: #111625 - abrir o leitor de PDF em 32 e 64 bits --- Lib/UtilsUnit.pas | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 5561533..8930cf7 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -141,6 +141,7 @@ procedure RemoveDiretorio(Dir: String); function ExtractBetween(const Value, A, B: string): string; function LocalizaElementoArray(Element: array of Integer; Valor: Integer): Boolean; function GetJsonValue(jsonObject: TJsonObject; campo: string): string; +function Is64BitOS: Boolean; implementation @@ -2362,5 +2363,23 @@ function GetJsonValue(jsonObject: TJsonObject; campo: string): string; Result := jsonObject.Get(campo).JsonValue.Value; end; +function Is64BitOS: Boolean; +const + PROCESSOR_ARCHITECTURE_INTEL = $0000; + PROCESSOR_ARCHITECTURE_IA64 = $0006; + PROCESSOR_ARCHITECTURE_AMD64 = $0009; + PROCESSOR_ARCHITECTURE_UNKNOWN = $FFFF; +var + xSysInfo: TSystemInfo; +begin + GetNativeSystemInfo(xSysInfo); + case xSysInfo.wProcessorArchitecture of + PROCESSOR_ARCHITECTURE_AMD64, PROCESSOR_ARCHITECTURE_IA64: + Result := True; + else + Result := False; + end; +end; + end. From 3363a9f8e106a49eea595ef5514e630a558b4220 Mon Sep 17 00:00:00 2001 From: Francisco Date: Thu, 14 Dec 2023 09:55:41 -0300 Subject: [PATCH 289/294] ticket_id: #117988 - imprimir laudo com acrobat em arquitetura 32 e 64 bits --- Lib/UtilsUnit.pas | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8930cf7..8b131ba 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -142,6 +142,7 @@ function ExtractBetween(const Value, A, B: string): string; function LocalizaElementoArray(Element: array of Integer; Valor: Integer): Boolean; function GetJsonValue(jsonObject: TJsonObject; campo: string): string; function Is64BitOS: Boolean; +function IsWindows64: Boolean; implementation @@ -2381,5 +2382,33 @@ function Is64BitOS: Boolean; end; end; +function IsWindows64: Boolean; +type + TIsWow64Process = function(AHandle:THandle; var AIsWow64: BOOL): BOOL; stdcall; +var + vKernel32Handle: DWORD; + vIsWow64Process: TIsWow64Process; + vIsWow64: BOOL; +begin + + Result := False; + + vKernel32Handle := LoadLibrary('kernel32.dll'); + if (vKernel32Handle = 0) then Exit; + + try + + @vIsWow64Process := GetProcAddress(vKernel32Handle, 'IsWow64Process'); + if not Assigned(vIsWow64Process) then Exit; + + vIsWow64 := False; + if (vIsWow64Process(GetCurrentProcess, vIsWow64)) then + Result := vIsWow64; + + finally + FreeLibrary(vKernel32Handle); + end; +end; + end. From d49c3b3d3bf7f61042b5dad145ae96825f67e87a Mon Sep 17 00:00:00 2001 From: Francisco Date: Fri, 22 Dec 2023 15:33:38 -0300 Subject: [PATCH 290/294] Adicionando o metodo Unzip ao UtilsUnit --- Lib/UtilsUnitGUI.pas | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/Lib/UtilsUnitGUI.pas b/Lib/UtilsUnitGUI.pas index 82aff8d..73eab1d 100644 --- a/Lib/UtilsUnitGUI.pas +++ b/Lib/UtilsUnitGUI.pas @@ -61,10 +61,11 @@ function ValidaTravamento(const Aplicacao: string; var FTaskName: string; var FP function ProcessExists(exeFileName: string; var FTaskName: string; var FPid: PDWORD_PTR; var FProcessa: Boolean; var FHWND: HWND; var iListOfProcess: Integer): Boolean; procedure MakeRounded(Control: TWinControl); function SendMessageToTCPServer(const aMessage: string; aPort: integer): boolean; +function UnZip(ZipName: string; Destination: string): boolean; implementation -uses IdIPWatch, IdTCPClient, WinSpool; +uses IdIPWatch, IdTCPClient, WinSpool, Zip; procedure setHabilitaButton(btn: TButton; enabled: boolean); begin @@ -951,6 +952,21 @@ procedure MakeRounded(Control: TWinControl); end; end; +function UnZip(ZipName: string; Destination: string): boolean; +var + UnZipper: TZipFile; +begin + UnZipper := TZipFile.Create(); + try + UnZipper.Open(ZipName, zmRead); + UnZipper.ExtractAll(Destination); + UnZipper.Close; + finally + FreeAndNil(UnZipper); + end; + Result := True; +end; + end. From 0ea5353fbeeee8a1021e260018558b37e130bccd Mon Sep 17 00:00:00 2001 From: Claudio Date: Tue, 4 Jun 2024 17:49:55 -0300 Subject: [PATCH 291/294] ticket_id :#122078 - Passando timeout para o ExecuteWait e voltando o processo por referencia --- Lib/osShellAPI.pas | 61 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/Lib/osShellAPI.pas b/Lib/osShellAPI.pas index 02bd86d..bea6bad 100644 --- a/Lib/osShellAPI.pas +++ b/Lib/osShellAPI.pas @@ -92,6 +92,7 @@ function VersionInfoProductVersion(p_exeName : String) : String; function VersionInfoComments(p_exeName : String) : String; function ExecuteWait(const p_commandLine : string; const p_commandShow: Word) : integer; +function ExecuteWaitTime(const p_commandLine : string; const p_commandShow: Word; const timeout: DWORD; var ProcessInfo: TProcessInformation) : integer; { Executa uma aplicação e espera até que ela termine Retorna: Codigo de Erro ou o ExitCode retornado pela aplicação executada } @@ -505,6 +506,66 @@ function ExecuteWait(const p_commandLine : string; const p_commandShow: Word) : Result := dwExitCode; end; +function ExecuteWaitTime(const p_commandLine : string; const p_commandShow: Word; const timeout: DWORD; var ProcessInfo: TProcessInformation) : integer; +var + pCommandLine : array[0..MAX_PATH] of char; + StartupInfo : TStartupInfo; + hAppProcess, hAppThread : THandle; + dwExitCode : DWORD; + bRet : boolean; +begin + StrPCopy(pCommandLine, p_commandLine); + hAppThread := 0; + hAppProcess := 0; +TRY +{ Prepare StartupInfo structure } + FillChar(StartupInfo, SizeOf(StartupInfo), #0); + StartupInfo.cb := SizeOf(StartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW or + STARTF_USESTDHANDLES; + StartupInfo.wShowWindow := p_commandShow; + StartupInfo.hStdOutput := 0; + StartupInfo.hStdInput := 0; + + dwExitCode := $FFFFFFFF; +{ Create the app } + bRet := CreateProcess( + nil, { pointer to name of executable module } + pCommandLine, { pointer to command line string } + nil, { pointer to process security attributes } + nil, { pointer to thread security attributes } + True, { handle inheritance flag } + HIGH_PRIORITY_CLASS,{ creation flags } + nil, { pointer to new environment block } + nil, { pointer to current directory name } + StartupInfo, { pointer to STARTUPINFO } + ProcessInfo); { pointer to PROCESS_INF } + +{ wait for the app to finish its job and take the handles to free them later } + if bRet then + begin + WaitforSingleObject(ProcessInfo.hProcess, timeout); + hAppProcess := ProcessInfo.hProcess; + hAppThread := ProcessInfo.hThread; + GetExitCodeProcess (hAppProcess, dwExitCode); + end + else + dwExitCode := GetLastError; + + FINALLY +{ Close the handles. + Kernel objects, like the process and the files + we created in this case, are maintained by a usage + count. So, for cleaning up purposes, we have to + close the handles to inform the system that we don't + need the objects anymore } + + + + end; + Result := dwExitCode; +end; + function GetFolder(aRoot: integer; aCaption :string): string; var pPrograms,pBrowse: PItemIDList; From 1efc4143fe054a52d1b2e221e0855925d0fccd6c Mon Sep 17 00:00:00 2001 From: Aldo Date: Mon, 2 Sep 2024 17:02:47 -0300 Subject: [PATCH 292/294] Ticket_id: #123996 - Problema ao acessar site de treinamento Signed-off-by: Wellington --- Lib/UtilsUnit.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/Lib/UtilsUnit.pas b/Lib/UtilsUnit.pas index 8b131ba..cca4353 100644 --- a/Lib/UtilsUnit.pas +++ b/Lib/UtilsUnit.pas @@ -1340,8 +1340,8 @@ function TestConnection(const url: String; conn: TosSQLConnection = nil): boolea HTTPClient := TidHTTP.Create(nil); LHandler := TIdSSLIOHandlerSocketOpenSSL.Create(HTTPClient); - LHandler.SSLOptions.Method := sslvSSLv23; - LHandler.SSLOptions.Mode := sslmUnassigned; + LHandler.SSLOptions.Method := sslvTLSv1_2; + LHandler.SSLOptions.Mode := sslmUnassigned; LHandler.SSLOptions.SSLVersions := AllSSLVersions; HTTPClient.IOHandler := LHandler; HTTPClient.HandleRedirects := True; @@ -1999,7 +1999,12 @@ function GetPageAsString(const url: String): String; if TestConnection(url) then begin lHTTP := TIdHTTP.Create(nil); + IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(lHTTP); + IOHandler.SSLOptions.Method := sslvTLSv1_2; + IOHandler.SSLOptions.Mode := sslmUnassigned; + IOHandler.SSLOptions.SSLVersions := AllSSLVersions; + lUri := TIdUri.Create; try lHTTP.IOHandler := IOHandler; From fca6134219236dde5172edd2846b4905d3712ed5 Mon Sep 17 00:00:00 2001 From: Aldo Date: Thu, 12 Sep 2024 10:54:57 -0300 Subject: [PATCH 293/294] Ticket_id: #123785 -(Acess violation) Signed-off-by: Wellington Signed-off-by: Claudio --- Forms/osCustomMainFrm.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Forms/osCustomMainFrm.pas b/Forms/osCustomMainFrm.pas index 67c9ba6..c2cbbed 100644 --- a/Forms/osCustomMainFrm.pas +++ b/Forms/osCustomMainFrm.pas @@ -1799,7 +1799,8 @@ procedure TosCustomMainForm.TreeView1Change(Sender: TObject; FCurrentResource := NewResource; Manager.currentResource := FCurrentResource; // Libera o datamodule associado - FCurrentDatamodule.Free; + if FCurrentDatamodule<>Nil then + FCurrentDatamodule.Free; FCurrentDatamodule := CreateCurrentDatamodule; // Libera o form corrente From 617e52716849fdc88aa318602763dff21558ce6b Mon Sep 17 00:00:00 2001 From: Claudio Date: Thu, 31 Oct 2024 14:59:58 -0300 Subject: [PATCH 294/294] versionando a biblioteca Microsoft XML --- Lib/MSXML2_TLB.pas | 5105 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 5105 insertions(+) create mode 100644 Lib/MSXML2_TLB.pas diff --git a/Lib/MSXML2_TLB.pas b/Lib/MSXML2_TLB.pas new file mode 100644 index 0000000..91485d8 --- /dev/null +++ b/Lib/MSXML2_TLB.pas @@ -0,0 +1,5105 @@ +unit MSXML2_TLB; + +// ************************************************************************ // +// WARNING +// ------- +// The types declared in this file were generated from data read from a +// Type Library. If this type library is explicitly or indirectly (via +// another type library referring to this type library) re-imported, or the +// 'Refresh' command of the Type Library Editor activated while editing the +// Type Library, the contents of this file will be regenerated and all +// manual modifications will be lost. +// ************************************************************************ // + +// PASTLWTR : 1.2 +// File generated on 30/07/2009 12:13:34 from Type Library described below. + +// ************************************************************************ // +// Type Lib: C:\Windows\System32\msxml6.dll (1) +// LIBID: {F5078F18-C551-11D3-89B9-0000F81FE221} +// LCID: 0 +// Helpfile: +// HelpString: Microsoft XML, v6.0 +// DepndLst: +// (1) v2.0 stdole, (C:\Windows\system32\stdole2.tlb) +// Errors: +// Hint: Parameter 'type' of IXMLDOMNode.nodeType changed to 'type_' +// Hint: Member 'implementation' of 'IXMLDOMDocument' changed to 'implementation_' +// Hint: Parameter 'type' of IXMLDOMDocument.createNode changed to 'type_' +// Hint: Parameter 'var' of IXMLDOMSchemaCollection.add changed to 'var_' +// Hint: Symbol 'type' renamed to 'type_' +// Hint: Parameter 'type' of ISchemaElement.type changed to 'type_' +// Hint: Symbol 'type' renamed to 'type_' +// Hint: Parameter 'type' of ISchemaAttribute.type changed to 'type_' +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. +{$WARN SYMBOL_PLATFORM OFF} +{$WRITEABLECONST ON} +{$VARPROPSETTER ON} +interface + +uses Windows, ActiveX, Classes, StdVCL, Variants; + + +// *********************************************************************// +// GUIDS declared in the TypeLibrary. Following prefixes are used: +// Type Libraries : LIBID_xxxx +// CoClasses : CLASS_xxxx +// DISPInterfaces : DIID_xxxx +// Non-DISP interfaces: IID_xxxx +// *********************************************************************// +const + // TypeLibrary Major and minor versions + MSXML2MajorVersion = 6; + MSXML2MinorVersion = 0; + + LIBID_MSXML2: TGUID = '{F5078F18-C551-11D3-89B9-0000F81FE221}'; + + IID_IXMLDOMImplementation: TGUID = '{2933BF8F-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNode: TGUID = '{2933BF80-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNodeList: TGUID = '{2933BF82-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNamedNodeMap: TGUID = '{2933BF83-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMDocument: TGUID = '{2933BF81-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMDocumentType: TGUID = '{2933BF8B-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMElement: TGUID = '{2933BF86-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMAttribute: TGUID = '{2933BF85-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMDocumentFragment: TGUID = '{3EFAA413-272F-11D2-836F-0000F87A7782}'; + IID_IXMLDOMCharacterData: TGUID = '{2933BF84-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMText: TGUID = '{2933BF87-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMComment: TGUID = '{2933BF88-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMCDATASection: TGUID = '{2933BF8A-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMProcessingInstruction: TGUID = '{2933BF89-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMEntityReference: TGUID = '{2933BF8E-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMParseError: TGUID = '{3EFAA426-272F-11D2-836F-0000F87A7782}'; + IID_IXMLDOMDocument2: TGUID = '{2933BF95-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMSchemaCollection: TGUID = '{373984C8-B845-449B-91E7-45AC83036ADE}'; + IID_IXMLDOMDocument3: TGUID = '{2933BF96-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMNotation: TGUID = '{2933BF8C-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMEntity: TGUID = '{2933BF8D-7B36-11D2-B20E-00C04F983E60}'; + IID_IXMLDOMParseError2: TGUID = '{3EFAA428-272F-11D2-836F-0000F87A7782}'; + IID_IXMLDOMParseErrorCollection: TGUID = '{3EFAA429-272F-11D2-836F-0000F87A7782}'; + IID_IXTLRuntime: TGUID = '{3EFAA425-272F-11D2-836F-0000F87A7782}'; + IID_IXSLTemplate: TGUID = '{2933BF93-7B36-11D2-B20E-00C04F983E60}'; + IID_IXSLProcessor: TGUID = '{2933BF92-7B36-11D2-B20E-00C04F983E60}'; + IID_ISAXXMLReader: TGUID = '{A4F96ED0-F829-476E-81C0-CDC7BD2A0802}'; + IID_ISAXEntityResolver: TGUID = '{99BCA7BD-E8C4-4D5F-A0CF-6D907901FF07}'; + IID_ISAXContentHandler: TGUID = '{1545CDFA-9E4E-4497-A8A4-2BF7D0112C44}'; + IID_ISAXLocator: TGUID = '{9B7E472A-0DE4-4640-BFF3-84D38A051C31}'; + IID_ISAXAttributes: TGUID = '{F078ABE1-45D2-4832-91EA-4466CE2F25C9}'; + IID_ISAXDTDHandler: TGUID = '{E15C1BAF-AFB3-4D60-8C36-19A8C45DEFED}'; + IID_ISAXErrorHandler: TGUID = '{A60511C4-CCF5-479E-98A3-DC8DC545B7D0}'; + IID_ISAXXMLFilter: TGUID = '{70409222-CA09-4475-ACB8-40312FE8D145}'; + IID_ISAXLexicalHandler: TGUID = '{7F85D5F5-47A8-4497-BDA5-84BA04819EA6}'; + IID_ISAXDeclHandler: TGUID = '{862629AC-771A-47B2-8337-4E6843C1BE90}'; + IID_IVBSAXXMLReader: TGUID = '{8C033CAA-6CD6-4F73-B728-4531AF74945F}'; + IID_IVBSAXEntityResolver: TGUID = '{0C05D096-F45B-4ACA-AD1A-AA0BC25518DC}'; + IID_IVBSAXContentHandler: TGUID = '{2ED7290A-4DD5-4B46-BB26-4E4155E77FAA}'; + IID_IVBSAXLocator: TGUID = '{796E7AC5-5AA2-4EFF-ACAD-3FAAF01A3288}'; + IID_IVBSAXAttributes: TGUID = '{10DC0586-132B-4CAC-8BB3-DB00AC8B7EE0}'; + IID_IVBSAXDTDHandler: TGUID = '{24FB3297-302D-4620-BA39-3A732D850558}'; + IID_IVBSAXErrorHandler: TGUID = '{D963D3FE-173C-4862-9095-B92F66995F52}'; + IID_IVBSAXXMLFilter: TGUID = '{1299EB1B-5B88-433E-82DE-82CA75AD4E04}'; + IID_IVBSAXLexicalHandler: TGUID = '{032AAC35-8C0E-4D9D-979F-E3B702935576}'; + IID_IVBSAXDeclHandler: TGUID = '{E8917260-7579-4BE1-B5DD-7AFBFA6F077B}'; + IID_IMXWriter: TGUID = '{4D7FF4BA-1565-4EA8-94E1-6E724A46F98D}'; + IID_IMXAttributes: TGUID = '{F10D27CC-3EC0-415C-8ED8-77AB1C5E7262}'; + IID_IMXReaderControl: TGUID = '{808F4E35-8D5A-4FBE-8466-33A41279ED30}'; + IID_IMXSchemaDeclHandler: TGUID = '{FA4BB38C-FAF9-4CCA-9302-D1DD0FE520DB}'; + IID_ISchemaItem: TGUID = '{50EA08B3-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaParticle: TGUID = '{50EA08B5-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaElement: TGUID = '{50EA08B7-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchema: TGUID = '{50EA08B4-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaItemCollection: TGUID = '{50EA08B2-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaStringCollection: TGUID = '{50EA08B1-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaType: TGUID = '{50EA08B8-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaComplexType: TGUID = '{50EA08B9-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaAny: TGUID = '{50EA08BC-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaModelGroup: TGUID = '{50EA08BB-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_IMXXMLFilter: TGUID = '{C90352F7-643C-4FBC-BB23-E996EB2D51FD}'; + IID_IXMLDOMSchemaCollection2: TGUID = '{50EA08B0-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaAttribute: TGUID = '{50EA08B6-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaAttributeGroup: TGUID = '{50EA08BA-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaIdentityConstraint: TGUID = '{50EA08BD-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_ISchemaNotation: TGUID = '{50EA08BE-DD1B-4664-9A50-C2F40F4BD79A}'; + IID_IXMLDOMSelection: TGUID = '{AA634FC7-5888-44A7-A257-3A47150D3A0E}'; + DIID_XMLDOMDocumentEvents: TGUID = '{3EFAA427-272F-11D2-836F-0000F87A7782}'; + IID_IDSOControl: TGUID = '{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'; + IID_IXMLHTTPRequest: TGUID = '{ED8C108D-4349-11D2-91A4-00C04F7969E8}'; + IID_IServerXMLHTTPRequest: TGUID = '{2E9196BF-13BA-4DD4-91CA-6C571F281495}'; + IID_IServerXMLHTTPRequest2: TGUID = '{2E01311B-C322-4B0A-BD77-B90CFDC8DCE7}'; + IID_IMXNamespacePrefixes: TGUID = '{C90352F4-643C-4FBC-BB23-E996EB2D51FD}'; + IID_IVBMXNamespaceManager: TGUID = '{C90352F5-643C-4FBC-BB23-E996EB2D51FD}'; + IID_IMXNamespaceManager: TGUID = '{C90352F6-643C-4FBC-BB23-E996EB2D51FD}'; + CLASS_DOMDocument: TGUID = '{F6D90F11-9C73-11D3-B32E-00C04F990BB4}'; + CLASS_DOMDocument26: TGUID = '{F5078F1B-C551-11D3-89B9-0000F81FE221}'; + CLASS_DOMDocument30: TGUID = '{F5078F32-C551-11D3-89B9-0000F81FE221}'; + CLASS_DOMDocument40: TGUID = '{88D969C0-F192-11D4-A65F-0040963251E5}'; + CLASS_DOMDocument60: TGUID = '{88D96A05-F192-11D4-A65F-0040963251E5}'; + CLASS_FreeThreadedDOMDocument: TGUID = '{F6D90F12-9C73-11D3-B32E-00C04F990BB4}'; + CLASS_FreeThreadedDOMDocument26: TGUID = '{F5078F1C-C551-11D3-89B9-0000F81FE221}'; + CLASS_FreeThreadedDOMDocument30: TGUID = '{F5078F33-C551-11D3-89B9-0000F81FE221}'; + CLASS_FreeThreadedDOMDocument40: TGUID = '{88D969C1-F192-11D4-A65F-0040963251E5}'; + CLASS_FreeThreadedDOMDocument60: TGUID = '{88D96A06-F192-11D4-A65F-0040963251E5}'; + CLASS_XMLSchemaCache: TGUID = '{373984C9-B845-449B-91E7-45AC83036ADE}'; + CLASS_XMLSchemaCache26: TGUID = '{F5078F1D-C551-11D3-89B9-0000F81FE221}'; + CLASS_XMLSchemaCache30: TGUID = '{F5078F34-C551-11D3-89B9-0000F81FE221}'; + CLASS_XMLSchemaCache40: TGUID = '{88D969C2-F192-11D4-A65F-0040963251E5}'; + CLASS_XMLSchemaCache60: TGUID = '{88D96A07-F192-11D4-A65F-0040963251E5}'; + CLASS_XSLTemplate: TGUID = '{2933BF94-7B36-11D2-B20E-00C04F983E60}'; + CLASS_XSLTemplate26: TGUID = '{F5078F21-C551-11D3-89B9-0000F81FE221}'; + CLASS_XSLTemplate30: TGUID = '{F5078F36-C551-11D3-89B9-0000F81FE221}'; + CLASS_XSLTemplate40: TGUID = '{88D969C3-F192-11D4-A65F-0040963251E5}'; + CLASS_XSLTemplate60: TGUID = '{88D96A08-F192-11D4-A65F-0040963251E5}'; + CLASS_DSOControl: TGUID = '{F6D90F14-9C73-11D3-B32E-00C04F990BB4}'; + CLASS_DSOControl26: TGUID = '{F5078F1F-C551-11D3-89B9-0000F81FE221}'; + CLASS_DSOControl30: TGUID = '{F5078F39-C551-11D3-89B9-0000F81FE221}'; + CLASS_DSOControl40: TGUID = '{88D969C4-F192-11D4-A65F-0040963251E5}'; + CLASS_XMLHTTP: TGUID = '{F6D90F16-9C73-11D3-B32E-00C04F990BB4}'; + CLASS_XMLHTTP26: TGUID = '{F5078F1E-C551-11D3-89B9-0000F81FE221}'; + CLASS_XMLHTTP30: TGUID = '{F5078F35-C551-11D3-89B9-0000F81FE221}'; + CLASS_XMLHTTP40: TGUID = '{88D969C5-F192-11D4-A65F-0040963251E5}'; + CLASS_XMLHTTP60: TGUID = '{88D96A0A-F192-11D4-A65F-0040963251E5}'; + CLASS_ServerXMLHTTP: TGUID = '{AFBA6B42-5692-48EA-8141-DC517DCF0EF1}'; + CLASS_ServerXMLHTTP30: TGUID = '{AFB40FFD-B609-40A3-9828-F88BBE11E4E3}'; + CLASS_ServerXMLHTTP40: TGUID = '{88D969C6-F192-11D4-A65F-0040963251E5}'; + CLASS_ServerXMLHTTP60: TGUID = '{88D96A0B-F192-11D4-A65F-0040963251E5}'; + CLASS_SAXXMLReader: TGUID = '{079AA557-4A18-424A-8EEE-E39F0A8D41B9}'; + CLASS_SAXXMLReader30: TGUID = '{3124C396-FB13-4836-A6AD-1317F1713688}'; + CLASS_SAXXMLReader40: TGUID = '{7C6E29BC-8B8B-4C3D-859E-AF6CD158BE0F}'; + CLASS_SAXXMLReader60: TGUID = '{88D96A0C-F192-11D4-A65F-0040963251E5}'; + CLASS_MXXMLWriter: TGUID = '{FC220AD8-A72A-4EE8-926E-0B7AD152A020}'; + CLASS_MXXMLWriter30: TGUID = '{3D813DFE-6C91-4A4E-8F41-04346A841D9C}'; + CLASS_MXXMLWriter40: TGUID = '{88D969C8-F192-11D4-A65F-0040963251E5}'; + CLASS_MXXMLWriter60: TGUID = '{88D96A0F-F192-11D4-A65F-0040963251E5}'; + CLASS_MXHTMLWriter: TGUID = '{A4C23EC3-6B70-4466-9127-550077239978}'; + CLASS_MXHTMLWriter30: TGUID = '{853D1540-C1A7-4AA9-A226-4D3BD301146D}'; + CLASS_MXHTMLWriter40: TGUID = '{88D969C9-F192-11D4-A65F-0040963251E5}'; + CLASS_MXHTMLWriter60: TGUID = '{88D96A10-F192-11D4-A65F-0040963251E5}'; + CLASS_SAXAttributes: TGUID = '{4DD441AD-526D-4A77-9F1B-9841ED802FB0}'; + CLASS_SAXAttributes30: TGUID = '{3E784A01-F3AE-4DC0-9354-9526B9370EBA}'; + CLASS_SAXAttributes40: TGUID = '{88D969CA-F192-11D4-A65F-0040963251E5}'; + CLASS_SAXAttributes60: TGUID = '{88D96A0E-F192-11D4-A65F-0040963251E5}'; + CLASS_MXNamespaceManager: TGUID = '{88D969D5-F192-11D4-A65F-0040963251E5}'; + CLASS_MXNamespaceManager40: TGUID = '{88D969D6-F192-11D4-A65F-0040963251E5}'; + CLASS_MXNamespaceManager60: TGUID = '{88D96A11-F192-11D4-A65F-0040963251E5}'; + +// *********************************************************************// +// Declaration of Enumerations defined in Type Library +// *********************************************************************// +// Constants for enum tagDOMNodeType +type + tagDOMNodeType = TOleEnum; +const + NODE_INVALID = $00000000; + NODE_ELEMENT = $00000001; + NODE_ATTRIBUTE = $00000002; + NODE_TEXT = $00000003; + NODE_CDATA_SECTION = $00000004; + NODE_ENTITY_REFERENCE = $00000005; + NODE_ENTITY = $00000006; + NODE_PROCESSING_INSTRUCTION = $00000007; + NODE_COMMENT = $00000008; + NODE_DOCUMENT = $00000009; + NODE_DOCUMENT_TYPE = $0000000A; + NODE_DOCUMENT_FRAGMENT = $0000000B; + NODE_NOTATION = $0000000C; + +// Constants for enum _SOMITEMTYPE +type + _SOMITEMTYPE = TOleEnum; +const + SOMITEM_SCHEMA = $00001000; + SOMITEM_ATTRIBUTE = $00001001; + SOMITEM_ATTRIBUTEGROUP = $00001002; + SOMITEM_NOTATION = $00001003; + SOMITEM_ANNOTATION = $00001004; + SOMITEM_IDENTITYCONSTRAINT = $00001100; + SOMITEM_KEY = $00001101; + SOMITEM_KEYREF = $00001102; + SOMITEM_UNIQUE = $00001103; + SOMITEM_ANYTYPE = $00002000; + SOMITEM_DATATYPE = $00002100; + SOMITEM_DATATYPE_ANYTYPE = $00002101; + SOMITEM_DATATYPE_ANYURI = $00002102; + SOMITEM_DATATYPE_BASE64BINARY = $00002103; + SOMITEM_DATATYPE_BOOLEAN = $00002104; + SOMITEM_DATATYPE_BYTE = $00002105; + SOMITEM_DATATYPE_DATE = $00002106; + SOMITEM_DATATYPE_DATETIME = $00002107; + SOMITEM_DATATYPE_DAY = $00002108; + SOMITEM_DATATYPE_DECIMAL = $00002109; + SOMITEM_DATATYPE_DOUBLE = $0000210A; + SOMITEM_DATATYPE_DURATION = $0000210B; + SOMITEM_DATATYPE_ENTITIES = $0000210C; + SOMITEM_DATATYPE_ENTITY = $0000210D; + SOMITEM_DATATYPE_FLOAT = $0000210E; + SOMITEM_DATATYPE_HEXBINARY = $0000210F; + SOMITEM_DATATYPE_ID = $00002110; + SOMITEM_DATATYPE_IDREF = $00002111; + SOMITEM_DATATYPE_IDREFS = $00002112; + SOMITEM_DATATYPE_INT = $00002113; + SOMITEM_DATATYPE_INTEGER = $00002114; + SOMITEM_DATATYPE_LANGUAGE = $00002115; + SOMITEM_DATATYPE_LONG = $00002116; + SOMITEM_DATATYPE_MONTH = $00002117; + SOMITEM_DATATYPE_MONTHDAY = $00002118; + SOMITEM_DATATYPE_NAME = $00002119; + SOMITEM_DATATYPE_NCNAME = $0000211A; + SOMITEM_DATATYPE_NEGATIVEINTEGER = $0000211B; + SOMITEM_DATATYPE_NMTOKEN = $0000211C; + SOMITEM_DATATYPE_NMTOKENS = $0000211D; + SOMITEM_DATATYPE_NONNEGATIVEINTEGER = $0000211E; + SOMITEM_DATATYPE_NONPOSITIVEINTEGER = $0000211F; + SOMITEM_DATATYPE_NORMALIZEDSTRING = $00002120; + SOMITEM_DATATYPE_NOTATION = $00002121; + SOMITEM_DATATYPE_POSITIVEINTEGER = $00002122; + SOMITEM_DATATYPE_QNAME = $00002123; + SOMITEM_DATATYPE_SHORT = $00002124; + SOMITEM_DATATYPE_STRING = $00002125; + SOMITEM_DATATYPE_TIME = $00002126; + SOMITEM_DATATYPE_TOKEN = $00002127; + SOMITEM_DATATYPE_UNSIGNEDBYTE = $00002128; + SOMITEM_DATATYPE_UNSIGNEDINT = $00002129; + SOMITEM_DATATYPE_UNSIGNEDLONG = $0000212A; + SOMITEM_DATATYPE_UNSIGNEDSHORT = $0000212B; + SOMITEM_DATATYPE_YEAR = $0000212C; + SOMITEM_DATATYPE_YEARMONTH = $0000212D; + SOMITEM_DATATYPE_ANYSIMPLETYPE = $000021FF; + SOMITEM_SIMPLETYPE = $00002200; + SOMITEM_COMPLEXTYPE = $00002400; + SOMITEM_PARTICLE = $00004000; + SOMITEM_ANY = $00004001; + SOMITEM_ANYATTRIBUTE = $00004002; + SOMITEM_ELEMENT = $00004003; + SOMITEM_GROUP = $00004100; + SOMITEM_ALL = $00004101; + SOMITEM_CHOICE = $00004102; + SOMITEM_SEQUENCE = $00004103; + SOMITEM_EMPTYPARTICLE = $00004104; + SOMITEM_NULL = $00000800; + SOMITEM_NULL_TYPE = $00002800; + SOMITEM_NULL_ANY = $00004801; + SOMITEM_NULL_ANYATTRIBUTE = $00004802; + SOMITEM_NULL_ELEMENT = $00004803; + +// Constants for enum _SCHEMADERIVATIONMETHOD +type + _SCHEMADERIVATIONMETHOD = TOleEnum; +const + SCHEMADERIVATIONMETHOD_EMPTY = $00000000; + SCHEMADERIVATIONMETHOD_SUBSTITUTION = $00000001; + SCHEMADERIVATIONMETHOD_EXTENSION = $00000002; + SCHEMADERIVATIONMETHOD_RESTRICTION = $00000004; + SCHEMADERIVATIONMETHOD_LIST = $00000008; + SCHEMADERIVATIONMETHOD_UNION = $00000010; + SCHEMADERIVATIONMETHOD_ALL = $000000FF; + SCHEMADERIVATIONMETHOD_NONE = $00000100; + +// Constants for enum _SCHEMATYPEVARIETY +type + _SCHEMATYPEVARIETY = TOleEnum; +const + SCHEMATYPEVARIETY_NONE = $FFFFFFFF; + SCHEMATYPEVARIETY_ATOMIC = $00000000; + SCHEMATYPEVARIETY_LIST = $00000001; + SCHEMATYPEVARIETY_UNION = $00000002; + +// Constants for enum _SCHEMAWHITESPACE +type + _SCHEMAWHITESPACE = TOleEnum; +const + SCHEMAWHITESPACE_NONE = $FFFFFFFF; + SCHEMAWHITESPACE_PRESERVE = $00000000; + SCHEMAWHITESPACE_REPLACE = $00000001; + SCHEMAWHITESPACE_COLLAPSE = $00000002; + +// Constants for enum _SCHEMAPROCESSCONTENTS +type + _SCHEMAPROCESSCONTENTS = TOleEnum; +const + SCHEMAPROCESSCONTENTS_NONE = $00000000; + SCHEMAPROCESSCONTENTS_SKIP = $00000001; + SCHEMAPROCESSCONTENTS_LAX = $00000002; + SCHEMAPROCESSCONTENTS_STRICT = $00000003; + +// Constants for enum _SCHEMACONTENTTYPE +type + _SCHEMACONTENTTYPE = TOleEnum; +const + SCHEMACONTENTTYPE_EMPTY = $00000000; + SCHEMACONTENTTYPE_TEXTONLY = $00000001; + SCHEMACONTENTTYPE_ELEMENTONLY = $00000002; + SCHEMACONTENTTYPE_MIXED = $00000003; + +// Constants for enum _SCHEMAUSE +type + _SCHEMAUSE = TOleEnum; +const + SCHEMAUSE_OPTIONAL = $00000000; + SCHEMAUSE_PROHIBITED = $00000001; + SCHEMAUSE_REQUIRED = $00000002; + +// Constants for enum _SERVERXMLHTTP_OPTION +type + _SERVERXMLHTTP_OPTION = TOleEnum; +const + SXH_OPTION_URL = $FFFFFFFF; + SXH_OPTION_URL_CODEPAGE = $00000000; + SXH_OPTION_ESCAPE_PERCENT_IN_URL = $00000001; + SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS = $00000002; + SXH_OPTION_SELECT_CLIENT_SSL_CERT = $00000003; + +// Constants for enum _SXH_SERVER_CERT_OPTION +type + _SXH_SERVER_CERT_OPTION = TOleEnum; +const + SXH_SERVER_CERT_IGNORE_UNKNOWN_CA = $00000100; + SXH_SERVER_CERT_IGNORE_WRONG_USAGE = $00000200; + SXH_SERVER_CERT_IGNORE_CERT_CN_INVALID = $00001000; + SXH_SERVER_CERT_IGNORE_CERT_DATE_INVALID = $00002000; + SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = $00003300; + +// Constants for enum _SXH_PROXY_SETTING +type + _SXH_PROXY_SETTING = TOleEnum; +const + SXH_PROXY_SET_DEFAULT = $00000000; + SXH_PROXY_SET_PRECONFIG = $00000000; + SXH_PROXY_SET_DIRECT = $00000001; + SXH_PROXY_SET_PROXY = $00000002; + +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IXMLDOMImplementation = interface; + IXMLDOMImplementationDisp = dispinterface; + IXMLDOMNode = interface; + IXMLDOMNodeDisp = dispinterface; + IXMLDOMNodeList = interface; + IXMLDOMNodeListDisp = dispinterface; + IXMLDOMNamedNodeMap = interface; + IXMLDOMNamedNodeMapDisp = dispinterface; + IXMLDOMDocument = interface; + IXMLDOMDocumentDisp = dispinterface; + IXMLDOMDocumentType = interface; + IXMLDOMDocumentTypeDisp = dispinterface; + IXMLDOMElement = interface; + IXMLDOMElementDisp = dispinterface; + IXMLDOMAttribute = interface; + IXMLDOMAttributeDisp = dispinterface; + IXMLDOMDocumentFragment = interface; + IXMLDOMDocumentFragmentDisp = dispinterface; + IXMLDOMCharacterData = interface; + IXMLDOMCharacterDataDisp = dispinterface; + IXMLDOMText = interface; + IXMLDOMTextDisp = dispinterface; + IXMLDOMComment = interface; + IXMLDOMCommentDisp = dispinterface; + IXMLDOMCDATASection = interface; + IXMLDOMCDATASectionDisp = dispinterface; + IXMLDOMProcessingInstruction = interface; + IXMLDOMProcessingInstructionDisp = dispinterface; + IXMLDOMEntityReference = interface; + IXMLDOMEntityReferenceDisp = dispinterface; + IXMLDOMParseError = interface; + IXMLDOMParseErrorDisp = dispinterface; + IXMLDOMDocument2 = interface; + IXMLDOMDocument2Disp = dispinterface; + IXMLDOMSchemaCollection = interface; + IXMLDOMSchemaCollectionDisp = dispinterface; + IXMLDOMDocument3 = interface; + IXMLDOMDocument3Disp = dispinterface; + IXMLDOMNotation = interface; + IXMLDOMNotationDisp = dispinterface; + IXMLDOMEntity = interface; + IXMLDOMEntityDisp = dispinterface; + IXMLDOMParseError2 = interface; + IXMLDOMParseError2Disp = dispinterface; + IXMLDOMParseErrorCollection = interface; + IXMLDOMParseErrorCollectionDisp = dispinterface; + IXTLRuntime = interface; + IXTLRuntimeDisp = dispinterface; + IXSLTemplate = interface; + IXSLTemplateDisp = dispinterface; + IXSLProcessor = interface; + IXSLProcessorDisp = dispinterface; + ISAXXMLReader = interface; + ISAXEntityResolver = interface; + ISAXContentHandler = interface; + ISAXLocator = interface; + ISAXAttributes = interface; + ISAXDTDHandler = interface; + ISAXErrorHandler = interface; + ISAXXMLFilter = interface; + ISAXLexicalHandler = interface; + ISAXDeclHandler = interface; + IVBSAXXMLReader = interface; + IVBSAXXMLReaderDisp = dispinterface; + IVBSAXEntityResolver = interface; + IVBSAXEntityResolverDisp = dispinterface; + IVBSAXContentHandler = interface; + IVBSAXContentHandlerDisp = dispinterface; + IVBSAXLocator = interface; + IVBSAXLocatorDisp = dispinterface; + IVBSAXAttributes = interface; + IVBSAXAttributesDisp = dispinterface; + IVBSAXDTDHandler = interface; + IVBSAXDTDHandlerDisp = dispinterface; + IVBSAXErrorHandler = interface; + IVBSAXErrorHandlerDisp = dispinterface; + IVBSAXXMLFilter = interface; + IVBSAXXMLFilterDisp = dispinterface; + IVBSAXLexicalHandler = interface; + IVBSAXLexicalHandlerDisp = dispinterface; + IVBSAXDeclHandler = interface; + IVBSAXDeclHandlerDisp = dispinterface; + IMXWriter = interface; + IMXWriterDisp = dispinterface; + IMXAttributes = interface; + IMXAttributesDisp = dispinterface; + IMXReaderControl = interface; + IMXReaderControlDisp = dispinterface; + IMXSchemaDeclHandler = interface; + IMXSchemaDeclHandlerDisp = dispinterface; + ISchemaItem = interface; + ISchemaItemDisp = dispinterface; + ISchemaParticle = interface; + ISchemaParticleDisp = dispinterface; + ISchemaElement = interface; + ISchemaElementDisp = dispinterface; + ISchema = interface; + ISchemaDisp = dispinterface; + ISchemaItemCollection = interface; + ISchemaItemCollectionDisp = dispinterface; + ISchemaStringCollection = interface; + ISchemaStringCollectionDisp = dispinterface; + ISchemaType = interface; + ISchemaTypeDisp = dispinterface; + ISchemaComplexType = interface; + ISchemaComplexTypeDisp = dispinterface; + ISchemaAny = interface; + ISchemaAnyDisp = dispinterface; + ISchemaModelGroup = interface; + ISchemaModelGroupDisp = dispinterface; + IMXXMLFilter = interface; + IMXXMLFilterDisp = dispinterface; + IXMLDOMSchemaCollection2 = interface; + IXMLDOMSchemaCollection2Disp = dispinterface; + ISchemaAttribute = interface; + ISchemaAttributeDisp = dispinterface; + ISchemaAttributeGroup = interface; + ISchemaAttributeGroupDisp = dispinterface; + ISchemaIdentityConstraint = interface; + ISchemaIdentityConstraintDisp = dispinterface; + ISchemaNotation = interface; + ISchemaNotationDisp = dispinterface; + IXMLDOMSelection = interface; + IXMLDOMSelectionDisp = dispinterface; + XMLDOMDocumentEvents = dispinterface; + IDSOControl = interface; + IDSOControlDisp = dispinterface; + IXMLHTTPRequest = interface; + IXMLHTTPRequestDisp = dispinterface; + IServerXMLHTTPRequest = interface; + IServerXMLHTTPRequestDisp = dispinterface; + IServerXMLHTTPRequest2 = interface; + IServerXMLHTTPRequest2Disp = dispinterface; + IMXNamespacePrefixes = interface; + IMXNamespacePrefixesDisp = dispinterface; + IVBMXNamespaceManager = interface; + IVBMXNamespaceManagerDisp = dispinterface; + IMXNamespaceManager = interface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + DOMDocument = IXMLDOMDocument2; + DOMDocument26 = IXMLDOMDocument2; + DOMDocument30 = IXMLDOMDocument2; + DOMDocument40 = IXMLDOMDocument2; + DOMDocument60 = IXMLDOMDocument3; + FreeThreadedDOMDocument = IXMLDOMDocument2; + FreeThreadedDOMDocument26 = IXMLDOMDocument2; + FreeThreadedDOMDocument30 = IXMLDOMDocument2; + FreeThreadedDOMDocument40 = IXMLDOMDocument2; + FreeThreadedDOMDocument60 = IXMLDOMDocument3; + XMLSchemaCache = IXMLDOMSchemaCollection; + XMLSchemaCache26 = IXMLDOMSchemaCollection; + XMLSchemaCache30 = IXMLDOMSchemaCollection; + XMLSchemaCache40 = IXMLDOMSchemaCollection2; + XMLSchemaCache60 = IXMLDOMSchemaCollection2; + XSLTemplate = IXSLTemplate; + XSLTemplate26 = IXSLTemplate; + XSLTemplate30 = IXSLTemplate; + XSLTemplate40 = IXSLTemplate; + XSLTemplate60 = IXSLTemplate; + DSOControl = IDSOControl; + DSOControl26 = IDSOControl; + DSOControl30 = IDSOControl; + DSOControl40 = IDSOControl; + XMLHTTP = IXMLHTTPRequest; + XMLHTTP26 = IXMLHTTPRequest; + XMLHTTP30 = IXMLHTTPRequest; + XMLHTTP40 = IXMLHTTPRequest; + XMLHTTP60 = IXMLHTTPRequest; + ServerXMLHTTP = IServerXMLHTTPRequest; + ServerXMLHTTP30 = IServerXMLHTTPRequest; + ServerXMLHTTP40 = IServerXMLHTTPRequest2; + ServerXMLHTTP60 = IServerXMLHTTPRequest2; + SAXXMLReader = IVBSAXXMLReader; + SAXXMLReader30 = IVBSAXXMLReader; + SAXXMLReader40 = IVBSAXXMLReader; + SAXXMLReader60 = IVBSAXXMLReader; + MXXMLWriter = IMXWriter; + MXXMLWriter30 = IMXWriter; + MXXMLWriter40 = IMXWriter; + MXXMLWriter60 = IMXWriter; + MXHTMLWriter = IMXWriter; + MXHTMLWriter30 = IMXWriter; + MXHTMLWriter40 = IMXWriter; + MXHTMLWriter60 = IMXWriter; + SAXAttributes = IMXAttributes; + SAXAttributes30 = IMXAttributes; + SAXAttributes40 = IMXAttributes; + SAXAttributes60 = IMXAttributes; + MXNamespaceManager = IVBMXNamespaceManager; + MXNamespaceManager40 = IVBMXNamespaceManager; + MXNamespaceManager60 = IVBMXNamespaceManager; + + +// *********************************************************************// +// Declaration of structures, unions and aliases. +// *********************************************************************// + PWord1 = ^Word; {*} + + DOMNodeType = tagDOMNodeType; + SOMITEMTYPE = _SOMITEMTYPE; + SCHEMADERIVATIONMETHOD = _SCHEMADERIVATIONMETHOD; + SCHEMATYPEVARIETY = _SCHEMATYPEVARIETY; + SCHEMAWHITESPACE = _SCHEMAWHITESPACE; + SCHEMAPROCESSCONTENTS = _SCHEMAPROCESSCONTENTS; + SCHEMACONTENTTYPE = _SCHEMACONTENTTYPE; + SCHEMAUSE = _SCHEMAUSE; + SERVERXMLHTTP_OPTION = _SERVERXMLHTTP_OPTION; + SXH_SERVER_CERT_OPTION = _SXH_SERVER_CERT_OPTION; + SXH_PROXY_SETTING = _SXH_PROXY_SETTING; + +// *********************************************************************// +// Interface: IXMLDOMImplementation +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8F-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMImplementation = interface(IDispatch) + ['{2933BF8F-7B36-11D2-B20E-00C04F983E60}'] + function hasFeature(const feature: WideString; const version: WideString): WordBool; safecall; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMImplementationDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8F-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMImplementationDisp = dispinterface + ['{2933BF8F-7B36-11D2-B20E-00C04F983E60}'] + function hasFeature(const feature: WideString; const version: WideString): WordBool; dispid 145; + end; + +// *********************************************************************// +// Interface: IXMLDOMNode +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF80-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNode = interface(IDispatch) + ['{2933BF80-7B36-11D2-B20E-00C04F983E60}'] + function Get_nodeName: WideString; safecall; + function Get_nodeValue: OleVariant; safecall; + procedure Set_nodeValue(value: OleVariant); safecall; + function Get_nodeType: DOMNodeType; safecall; + function Get_parentNode: IXMLDOMNode; safecall; + function Get_childNodes: IXMLDOMNodeList; safecall; + function Get_firstChild: IXMLDOMNode; safecall; + function Get_lastChild: IXMLDOMNode; safecall; + function Get_previousSibling: IXMLDOMNode; safecall; + function Get_nextSibling: IXMLDOMNode; safecall; + function Get_attributes: IXMLDOMNamedNodeMap; safecall; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; safecall; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; safecall; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; safecall; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; safecall; + function hasChildNodes: WordBool; safecall; + function Get_ownerDocument: IXMLDOMDocument; safecall; + function cloneNode(deep: WordBool): IXMLDOMNode; safecall; + function Get_nodeTypeString: WideString; safecall; + function Get_text: WideString; safecall; + procedure Set_text(const text: WideString); safecall; + function Get_specified: WordBool; safecall; + function Get_definition: IXMLDOMNode; safecall; + function Get_nodeTypedValue: OleVariant; safecall; + procedure Set_nodeTypedValue(typedValue: OleVariant); safecall; + function Get_dataType: OleVariant; safecall; + procedure Set_dataType(const dataTypeName: WideString); safecall; + function Get_xml: WideString; safecall; + function transformNode(const stylesheet: IXMLDOMNode): WideString; safecall; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; safecall; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; safecall; + function Get_parsed: WordBool; safecall; + function Get_namespaceURI: WideString; safecall; + function Get_prefix: WideString; safecall; + function Get_baseName: WideString; safecall; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); safecall; + property nodeName: WideString read Get_nodeName; + property nodeValue: OleVariant read Get_nodeValue write Set_nodeValue; + property nodeType: DOMNodeType read Get_nodeType; + property parentNode: IXMLDOMNode read Get_parentNode; + property childNodes: IXMLDOMNodeList read Get_childNodes; + property firstChild: IXMLDOMNode read Get_firstChild; + property lastChild: IXMLDOMNode read Get_lastChild; + property previousSibling: IXMLDOMNode read Get_previousSibling; + property nextSibling: IXMLDOMNode read Get_nextSibling; + property attributes: IXMLDOMNamedNodeMap read Get_attributes; + property ownerDocument: IXMLDOMDocument read Get_ownerDocument; + property nodeTypeString: WideString read Get_nodeTypeString; + property text: WideString read Get_text write Set_text; + property specified: WordBool read Get_specified; + property definition: IXMLDOMNode read Get_definition; + property nodeTypedValue: OleVariant read Get_nodeTypedValue write Set_nodeTypedValue; + property xml: WideString read Get_xml; + property parsed: WordBool read Get_parsed; + property namespaceURI: WideString read Get_namespaceURI; + property prefix: WideString read Get_prefix; + property baseName: WideString read Get_baseName; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNodeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF80-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNodeDisp = dispinterface + ['{2933BF80-7B36-11D2-B20E-00C04F983E60}'] + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMNodeList +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF82-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNodeList = interface(IDispatch) + ['{2933BF82-7B36-11D2-B20E-00C04F983E60}'] + function Get_item(index: Integer): IXMLDOMNode; safecall; + function Get_length: Integer; safecall; + function nextNode: IXMLDOMNode; safecall; + procedure reset; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: IXMLDOMNode read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNodeListDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF82-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNodeListDisp = dispinterface + ['{2933BF82-7B36-11D2-B20E-00C04F983E60}'] + property item[index: Integer]: IXMLDOMNode readonly dispid 0; default; + property length: Integer readonly dispid 74; + function nextNode: IXMLDOMNode; dispid 76; + procedure reset; dispid 77; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: IXMLDOMNamedNodeMap +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF83-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNamedNodeMap = interface(IDispatch) + ['{2933BF83-7B36-11D2-B20E-00C04F983E60}'] + function getNamedItem(const name: WideString): IXMLDOMNode; safecall; + function setNamedItem(const newItem: IXMLDOMNode): IXMLDOMNode; safecall; + function removeNamedItem(const name: WideString): IXMLDOMNode; safecall; + function Get_item(index: Integer): IXMLDOMNode; safecall; + function Get_length: Integer; safecall; + function getQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; safecall; + function removeQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; safecall; + function nextNode: IXMLDOMNode; safecall; + procedure reset; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: IXMLDOMNode read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNamedNodeMapDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF83-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNamedNodeMapDisp = dispinterface + ['{2933BF83-7B36-11D2-B20E-00C04F983E60}'] + function getNamedItem(const name: WideString): IXMLDOMNode; dispid 83; + function setNamedItem(const newItem: IXMLDOMNode): IXMLDOMNode; dispid 84; + function removeNamedItem(const name: WideString): IXMLDOMNode; dispid 85; + property item[index: Integer]: IXMLDOMNode readonly dispid 0; default; + property length: Integer readonly dispid 74; + function getQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 87; + function removeQualifiedItem(const baseName: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 88; + function nextNode: IXMLDOMNode; dispid 89; + procedure reset; dispid 90; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: IXMLDOMDocument +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF81-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocument = interface(IXMLDOMNode) + ['{2933BF81-7B36-11D2-B20E-00C04F983E60}'] + function Get_doctype: IXMLDOMDocumentType; safecall; + function Get_implementation_: IXMLDOMImplementation; safecall; + function Get_documentElement: IXMLDOMElement; safecall; + procedure _Set_documentElement(const DOMElement: IXMLDOMElement); safecall; + function createElement(const tagName: WideString): IXMLDOMElement; safecall; + function createDocumentFragment: IXMLDOMDocumentFragment; safecall; + function createTextNode(const data: WideString): IXMLDOMText; safecall; + function createComment(const data: WideString): IXMLDOMComment; safecall; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; safecall; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; safecall; + function createAttribute(const name: WideString): IXMLDOMAttribute; safecall; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; safecall; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; safecall; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; safecall; + function nodeFromID(const idString: WideString): IXMLDOMNode; safecall; + function load(xmlSource: OleVariant): WordBool; safecall; + function Get_readyState: Integer; safecall; + function Get_parseError: IXMLDOMParseError; safecall; + function Get_url: WideString; safecall; + function Get_async: WordBool; safecall; + procedure Set_async(isAsync: WordBool); safecall; + procedure abort; safecall; + function loadXML(const bstrXML: WideString): WordBool; safecall; + procedure save(destination: OleVariant); safecall; + function Get_validateOnParse: WordBool; safecall; + procedure Set_validateOnParse(isValidating: WordBool); safecall; + function Get_resolveExternals: WordBool; safecall; + procedure Set_resolveExternals(isResolving: WordBool); safecall; + function Get_preserveWhiteSpace: WordBool; safecall; + procedure Set_preserveWhiteSpace(isPreserving: WordBool); safecall; + procedure Set_onreadystatechange(Param1: OleVariant); safecall; + procedure Set_ondataavailable(Param1: OleVariant); safecall; + procedure Set_ontransformnode(Param1: OleVariant); safecall; + property doctype: IXMLDOMDocumentType read Get_doctype; + property implementation_: IXMLDOMImplementation read Get_implementation_; + property documentElement: IXMLDOMElement read Get_documentElement write _Set_documentElement; + property readyState: Integer read Get_readyState; + property parseError: IXMLDOMParseError read Get_parseError; + property url: WideString read Get_url; + property async: WordBool read Get_async write Set_async; + property validateOnParse: WordBool read Get_validateOnParse write Set_validateOnParse; + property resolveExternals: WordBool read Get_resolveExternals write Set_resolveExternals; + property preserveWhiteSpace: WordBool read Get_preserveWhiteSpace write Set_preserveWhiteSpace; + property onreadystatechange: OleVariant write Set_onreadystatechange; + property ondataavailable: OleVariant write Set_ondataavailable; + property ontransformnode: OleVariant write Set_ontransformnode; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocumentDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF81-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocumentDisp = dispinterface + ['{2933BF81-7B36-11D2-B20E-00C04F983E60}'] + property doctype: IXMLDOMDocumentType readonly dispid 38; + property implementation_: IXMLDOMImplementation readonly dispid 39; + property documentElement: IXMLDOMElement dispid 40; + function createElement(const tagName: WideString): IXMLDOMElement; dispid 41; + function createDocumentFragment: IXMLDOMDocumentFragment; dispid 42; + function createTextNode(const data: WideString): IXMLDOMText; dispid 43; + function createComment(const data: WideString): IXMLDOMComment; dispid 44; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; dispid 45; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; dispid 46; + function createAttribute(const name: WideString): IXMLDOMAttribute; dispid 47; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; dispid 49; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; dispid 50; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 54; + function nodeFromID(const idString: WideString): IXMLDOMNode; dispid 56; + function load(xmlSource: OleVariant): WordBool; dispid 58; + property readyState: Integer readonly dispid -525; + property parseError: IXMLDOMParseError readonly dispid 59; + property url: WideString readonly dispid 60; + property async: WordBool dispid 61; + procedure abort; dispid 62; + function loadXML(const bstrXML: WideString): WordBool; dispid 63; + procedure save(destination: OleVariant); dispid 64; + property validateOnParse: WordBool dispid 65; + property resolveExternals: WordBool dispid 66; + property preserveWhiteSpace: WordBool dispid 67; + property onreadystatechange: OleVariant writeonly dispid 68; + property ondataavailable: OleVariant writeonly dispid 69; + property ontransformnode: OleVariant writeonly dispid 70; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMDocumentType +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8B-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocumentType = interface(IXMLDOMNode) + ['{2933BF8B-7B36-11D2-B20E-00C04F983E60}'] + function Get_name: WideString; safecall; + function Get_entities: IXMLDOMNamedNodeMap; safecall; + function Get_notations: IXMLDOMNamedNodeMap; safecall; + property name: WideString read Get_name; + property entities: IXMLDOMNamedNodeMap read Get_entities; + property notations: IXMLDOMNamedNodeMap read Get_notations; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocumentTypeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8B-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocumentTypeDisp = dispinterface + ['{2933BF8B-7B36-11D2-B20E-00C04F983E60}'] + property name: WideString readonly dispid 131; + property entities: IXMLDOMNamedNodeMap readonly dispid 132; + property notations: IXMLDOMNamedNodeMap readonly dispid 133; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMElement +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF86-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMElement = interface(IXMLDOMNode) + ['{2933BF86-7B36-11D2-B20E-00C04F983E60}'] + function Get_tagName: WideString; safecall; + function getAttribute(const name: WideString): OleVariant; safecall; + procedure setAttribute(const name: WideString; value: OleVariant); safecall; + procedure removeAttribute(const name: WideString); safecall; + function getAttributeNode(const name: WideString): IXMLDOMAttribute; safecall; + function setAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; safecall; + function removeAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; safecall; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; safecall; + procedure normalize; safecall; + property tagName: WideString read Get_tagName; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMElementDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF86-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMElementDisp = dispinterface + ['{2933BF86-7B36-11D2-B20E-00C04F983E60}'] + property tagName: WideString readonly dispid 97; + function getAttribute(const name: WideString): OleVariant; dispid 99; + procedure setAttribute(const name: WideString; value: OleVariant); dispid 100; + procedure removeAttribute(const name: WideString); dispid 101; + function getAttributeNode(const name: WideString): IXMLDOMAttribute; dispid 102; + function setAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; dispid 103; + function removeAttributeNode(const DOMAttribute: IXMLDOMAttribute): IXMLDOMAttribute; dispid 104; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; dispid 105; + procedure normalize; dispid 106; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMAttribute +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF85-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMAttribute = interface(IXMLDOMNode) + ['{2933BF85-7B36-11D2-B20E-00C04F983E60}'] + function Get_name: WideString; safecall; + function Get_value: OleVariant; safecall; + procedure Set_value(attributeValue: OleVariant); safecall; + property name: WideString read Get_name; + property value: OleVariant read Get_value write Set_value; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMAttributeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF85-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMAttributeDisp = dispinterface + ['{2933BF85-7B36-11D2-B20E-00C04F983E60}'] + property name: WideString readonly dispid 118; + property value: OleVariant dispid 120; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMDocumentFragment +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA413-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMDocumentFragment = interface(IXMLDOMNode) + ['{3EFAA413-272F-11D2-836F-0000F87A7782}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocumentFragmentDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA413-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMDocumentFragmentDisp = dispinterface + ['{3EFAA413-272F-11D2-836F-0000F87A7782}'] + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMCharacterData +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF84-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCharacterData = interface(IXMLDOMNode) + ['{2933BF84-7B36-11D2-B20E-00C04F983E60}'] + function Get_data: WideString; safecall; + procedure Set_data(const data: WideString); safecall; + function Get_length: Integer; safecall; + function substringData(offset: Integer; count: Integer): WideString; safecall; + procedure appendData(const data: WideString); safecall; + procedure insertData(offset: Integer; const data: WideString); safecall; + procedure deleteData(offset: Integer; count: Integer); safecall; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); safecall; + property data: WideString read Get_data write Set_data; + property length: Integer read Get_length; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMCharacterDataDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF84-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCharacterDataDisp = dispinterface + ['{2933BF84-7B36-11D2-B20E-00C04F983E60}'] + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMText +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF87-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMText = interface(IXMLDOMCharacterData) + ['{2933BF87-7B36-11D2-B20E-00C04F983E60}'] + procedure GhostMethod_IXMLDOMText_0_1; safecall; + procedure GhostMethod_IXMLDOMText_4_2; safecall; + procedure GhostMethod_IXMLDOMText_8_3; safecall; + procedure GhostMethod_IXMLDOMText_12_4; safecall; + procedure GhostMethod_IXMLDOMText_16_5; safecall; + procedure GhostMethod_IXMLDOMText_20_6; safecall; + procedure GhostMethod_IXMLDOMText_24_7; safecall; + procedure GhostMethod_IXMLDOMText_28_8; safecall; + procedure GhostMethod_IXMLDOMText_32_9; safecall; + procedure GhostMethod_IXMLDOMText_36_10; safecall; + procedure GhostMethod_IXMLDOMText_40_11; safecall; + procedure GhostMethod_IXMLDOMText_44_12; safecall; + procedure GhostMethod_IXMLDOMText_48_13; safecall; + procedure GhostMethod_IXMLDOMText_52_14; safecall; + procedure GhostMethod_IXMLDOMText_56_15; safecall; + procedure GhostMethod_IXMLDOMText_60_16; safecall; + procedure GhostMethod_IXMLDOMText_64_17; safecall; + procedure GhostMethod_IXMLDOMText_68_18; safecall; + procedure GhostMethod_IXMLDOMText_72_19; safecall; + procedure GhostMethod_IXMLDOMText_76_20; safecall; + procedure GhostMethod_IXMLDOMText_80_21; safecall; + procedure GhostMethod_IXMLDOMText_84_22; safecall; + procedure GhostMethod_IXMLDOMText_88_23; safecall; + procedure GhostMethod_IXMLDOMText_92_24; safecall; + procedure GhostMethod_IXMLDOMText_96_25; safecall; + procedure GhostMethod_IXMLDOMText_100_26; safecall; + procedure GhostMethod_IXMLDOMText_104_27; safecall; + procedure GhostMethod_IXMLDOMText_108_28; safecall; + procedure GhostMethod_IXMLDOMText_112_29; safecall; + procedure GhostMethod_IXMLDOMText_116_30; safecall; + procedure GhostMethod_IXMLDOMText_120_31; safecall; + procedure GhostMethod_IXMLDOMText_124_32; safecall; + procedure GhostMethod_IXMLDOMText_128_33; safecall; + procedure GhostMethod_IXMLDOMText_132_34; safecall; + procedure GhostMethod_IXMLDOMText_136_35; safecall; + procedure GhostMethod_IXMLDOMText_140_36; safecall; + procedure GhostMethod_IXMLDOMText_144_37; safecall; + procedure GhostMethod_IXMLDOMText_148_38; safecall; + procedure GhostMethod_IXMLDOMText_152_39; safecall; + procedure GhostMethod_IXMLDOMText_156_40; safecall; + procedure GhostMethod_IXMLDOMText_160_41; safecall; + procedure GhostMethod_IXMLDOMText_164_42; safecall; + procedure GhostMethod_IXMLDOMText_168_43; safecall; + procedure GhostMethod_IXMLDOMText_172_44; safecall; + procedure GhostMethod_IXMLDOMText_176_45; safecall; + procedure GhostMethod_IXMLDOMText_180_46; safecall; + procedure GhostMethod_IXMLDOMText_184_47; safecall; + procedure GhostMethod_IXMLDOMText_188_48; safecall; + procedure GhostMethod_IXMLDOMText_192_49; safecall; + procedure GhostMethod_IXMLDOMText_196_50; safecall; + procedure GhostMethod_IXMLDOMText_200_51; safecall; + function splitText(offset: Integer): IXMLDOMText; safecall; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMTextDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF87-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMTextDisp = dispinterface + ['{2933BF87-7B36-11D2-B20E-00C04F983E60}'] + procedure GhostMethod_IXMLDOMText_0_1; dispid 1610678272; + procedure GhostMethod_IXMLDOMText_4_2; dispid 1610678273; + procedure GhostMethod_IXMLDOMText_8_3; dispid 1610678274; + procedure GhostMethod_IXMLDOMText_12_4; dispid 1610678275; + procedure GhostMethod_IXMLDOMText_16_5; dispid 1610678276; + procedure GhostMethod_IXMLDOMText_20_6; dispid 1610678277; + procedure GhostMethod_IXMLDOMText_24_7; dispid 1610678278; + procedure GhostMethod_IXMLDOMText_28_8; dispid 1610678279; + procedure GhostMethod_IXMLDOMText_32_9; dispid 1610678280; + procedure GhostMethod_IXMLDOMText_36_10; dispid 1610678281; + procedure GhostMethod_IXMLDOMText_40_11; dispid 1610678282; + procedure GhostMethod_IXMLDOMText_44_12; dispid 1610678283; + procedure GhostMethod_IXMLDOMText_48_13; dispid 1610678284; + procedure GhostMethod_IXMLDOMText_52_14; dispid 1610678285; + procedure GhostMethod_IXMLDOMText_56_15; dispid 1610678286; + procedure GhostMethod_IXMLDOMText_60_16; dispid 1610678287; + procedure GhostMethod_IXMLDOMText_64_17; dispid 1610678288; + procedure GhostMethod_IXMLDOMText_68_18; dispid 1610678289; + procedure GhostMethod_IXMLDOMText_72_19; dispid 1610678290; + procedure GhostMethod_IXMLDOMText_76_20; dispid 1610678291; + procedure GhostMethod_IXMLDOMText_80_21; dispid 1610678292; + procedure GhostMethod_IXMLDOMText_84_22; dispid 1610678293; + procedure GhostMethod_IXMLDOMText_88_23; dispid 1610678294; + procedure GhostMethod_IXMLDOMText_92_24; dispid 1610678295; + procedure GhostMethod_IXMLDOMText_96_25; dispid 1610678296; + procedure GhostMethod_IXMLDOMText_100_26; dispid 1610678297; + procedure GhostMethod_IXMLDOMText_104_27; dispid 1610678298; + procedure GhostMethod_IXMLDOMText_108_28; dispid 1610678299; + procedure GhostMethod_IXMLDOMText_112_29; dispid 1610678300; + procedure GhostMethod_IXMLDOMText_116_30; dispid 1610678301; + procedure GhostMethod_IXMLDOMText_120_31; dispid 1610678302; + procedure GhostMethod_IXMLDOMText_124_32; dispid 1610678303; + procedure GhostMethod_IXMLDOMText_128_33; dispid 1610678304; + procedure GhostMethod_IXMLDOMText_132_34; dispid 1610678305; + procedure GhostMethod_IXMLDOMText_136_35; dispid 1610678306; + procedure GhostMethod_IXMLDOMText_140_36; dispid 1610678307; + procedure GhostMethod_IXMLDOMText_144_37; dispid 1610678308; + procedure GhostMethod_IXMLDOMText_148_38; dispid 1610678309; + procedure GhostMethod_IXMLDOMText_152_39; dispid 1610678310; + procedure GhostMethod_IXMLDOMText_156_40; dispid 1610678311; + procedure GhostMethod_IXMLDOMText_160_41; dispid 1610678312; + procedure GhostMethod_IXMLDOMText_164_42; dispid 1610678313; + procedure GhostMethod_IXMLDOMText_168_43; dispid 1610678314; + procedure GhostMethod_IXMLDOMText_172_44; dispid 1610678315; + procedure GhostMethod_IXMLDOMText_176_45; dispid 1610678316; + procedure GhostMethod_IXMLDOMText_180_46; dispid 1610678317; + procedure GhostMethod_IXMLDOMText_184_47; dispid 1610678318; + procedure GhostMethod_IXMLDOMText_188_48; dispid 1610678319; + procedure GhostMethod_IXMLDOMText_192_49; dispid 1610678320; + procedure GhostMethod_IXMLDOMText_196_50; dispid 1610678321; + procedure GhostMethod_IXMLDOMText_200_51; dispid 1610678322; + function splitText(offset: Integer): IXMLDOMText; dispid 123; + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMComment +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF88-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMComment = interface(IXMLDOMCharacterData) + ['{2933BF88-7B36-11D2-B20E-00C04F983E60}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMCommentDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF88-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCommentDisp = dispinterface + ['{2933BF88-7B36-11D2-B20E-00C04F983E60}'] + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMCDATASection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8A-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCDATASection = interface(IXMLDOMText) + ['{2933BF8A-7B36-11D2-B20E-00C04F983E60}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMCDATASectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8A-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMCDATASectionDisp = dispinterface + ['{2933BF8A-7B36-11D2-B20E-00C04F983E60}'] + procedure GhostMethod_IXMLDOMText_0_1; dispid 1610678272; + procedure GhostMethod_IXMLDOMText_4_2; dispid 1610678273; + procedure GhostMethod_IXMLDOMText_8_3; dispid 1610678274; + procedure GhostMethod_IXMLDOMText_12_4; dispid 1610678275; + procedure GhostMethod_IXMLDOMText_16_5; dispid 1610678276; + procedure GhostMethod_IXMLDOMText_20_6; dispid 1610678277; + procedure GhostMethod_IXMLDOMText_24_7; dispid 1610678278; + procedure GhostMethod_IXMLDOMText_28_8; dispid 1610678279; + procedure GhostMethod_IXMLDOMText_32_9; dispid 1610678280; + procedure GhostMethod_IXMLDOMText_36_10; dispid 1610678281; + procedure GhostMethod_IXMLDOMText_40_11; dispid 1610678282; + procedure GhostMethod_IXMLDOMText_44_12; dispid 1610678283; + procedure GhostMethod_IXMLDOMText_48_13; dispid 1610678284; + procedure GhostMethod_IXMLDOMText_52_14; dispid 1610678285; + procedure GhostMethod_IXMLDOMText_56_15; dispid 1610678286; + procedure GhostMethod_IXMLDOMText_60_16; dispid 1610678287; + procedure GhostMethod_IXMLDOMText_64_17; dispid 1610678288; + procedure GhostMethod_IXMLDOMText_68_18; dispid 1610678289; + procedure GhostMethod_IXMLDOMText_72_19; dispid 1610678290; + procedure GhostMethod_IXMLDOMText_76_20; dispid 1610678291; + procedure GhostMethod_IXMLDOMText_80_21; dispid 1610678292; + procedure GhostMethod_IXMLDOMText_84_22; dispid 1610678293; + procedure GhostMethod_IXMLDOMText_88_23; dispid 1610678294; + procedure GhostMethod_IXMLDOMText_92_24; dispid 1610678295; + procedure GhostMethod_IXMLDOMText_96_25; dispid 1610678296; + procedure GhostMethod_IXMLDOMText_100_26; dispid 1610678297; + procedure GhostMethod_IXMLDOMText_104_27; dispid 1610678298; + procedure GhostMethod_IXMLDOMText_108_28; dispid 1610678299; + procedure GhostMethod_IXMLDOMText_112_29; dispid 1610678300; + procedure GhostMethod_IXMLDOMText_116_30; dispid 1610678301; + procedure GhostMethod_IXMLDOMText_120_31; dispid 1610678302; + procedure GhostMethod_IXMLDOMText_124_32; dispid 1610678303; + procedure GhostMethod_IXMLDOMText_128_33; dispid 1610678304; + procedure GhostMethod_IXMLDOMText_132_34; dispid 1610678305; + procedure GhostMethod_IXMLDOMText_136_35; dispid 1610678306; + procedure GhostMethod_IXMLDOMText_140_36; dispid 1610678307; + procedure GhostMethod_IXMLDOMText_144_37; dispid 1610678308; + procedure GhostMethod_IXMLDOMText_148_38; dispid 1610678309; + procedure GhostMethod_IXMLDOMText_152_39; dispid 1610678310; + procedure GhostMethod_IXMLDOMText_156_40; dispid 1610678311; + procedure GhostMethod_IXMLDOMText_160_41; dispid 1610678312; + procedure GhostMethod_IXMLDOMText_164_42; dispid 1610678313; + procedure GhostMethod_IXMLDOMText_168_43; dispid 1610678314; + procedure GhostMethod_IXMLDOMText_172_44; dispid 1610678315; + procedure GhostMethod_IXMLDOMText_176_45; dispid 1610678316; + procedure GhostMethod_IXMLDOMText_180_46; dispid 1610678317; + procedure GhostMethod_IXMLDOMText_184_47; dispid 1610678318; + procedure GhostMethod_IXMLDOMText_188_48; dispid 1610678319; + procedure GhostMethod_IXMLDOMText_192_49; dispid 1610678320; + procedure GhostMethod_IXMLDOMText_196_50; dispid 1610678321; + procedure GhostMethod_IXMLDOMText_200_51; dispid 1610678322; + function splitText(offset: Integer): IXMLDOMText; dispid 123; + property data: WideString dispid 109; + property length: Integer readonly dispid 110; + function substringData(offset: Integer; count: Integer): WideString; dispid 111; + procedure appendData(const data: WideString); dispid 112; + procedure insertData(offset: Integer; const data: WideString); dispid 113; + procedure deleteData(offset: Integer; count: Integer); dispid 114; + procedure replaceData(offset: Integer; count: Integer; const data: WideString); dispid 115; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMProcessingInstruction +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF89-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMProcessingInstruction = interface(IXMLDOMNode) + ['{2933BF89-7B36-11D2-B20E-00C04F983E60}'] + function Get_target: WideString; safecall; + function Get_data: WideString; safecall; + procedure Set_data(const value: WideString); safecall; + property target: WideString read Get_target; + property data: WideString read Get_data write Set_data; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMProcessingInstructionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF89-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMProcessingInstructionDisp = dispinterface + ['{2933BF89-7B36-11D2-B20E-00C04F983E60}'] + property target: WideString readonly dispid 127; + property data: WideString dispid 128; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMEntityReference +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8E-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntityReference = interface(IXMLDOMNode) + ['{2933BF8E-7B36-11D2-B20E-00C04F983E60}'] + end; + +// *********************************************************************// +// DispIntf: IXMLDOMEntityReferenceDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8E-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntityReferenceDisp = dispinterface + ['{2933BF8E-7B36-11D2-B20E-00C04F983E60}'] + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMParseError +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA426-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseError = interface(IDispatch) + ['{3EFAA426-272F-11D2-836F-0000F87A7782}'] + function Get_errorCode: Integer; safecall; + function Get_url: WideString; safecall; + function Get_reason: WideString; safecall; + function Get_srcText: WideString; safecall; + function Get_line: Integer; safecall; + function Get_linepos: Integer; safecall; + function Get_filepos: Integer; safecall; + property errorCode: Integer read Get_errorCode; + property url: WideString read Get_url; + property reason: WideString read Get_reason; + property srcText: WideString read Get_srcText; + property line: Integer read Get_line; + property linepos: Integer read Get_linepos; + property filepos: Integer read Get_filepos; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMParseErrorDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA426-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseErrorDisp = dispinterface + ['{3EFAA426-272F-11D2-836F-0000F87A7782}'] + property errorCode: Integer readonly dispid 0; + property url: WideString readonly dispid 179; + property reason: WideString readonly dispid 180; + property srcText: WideString readonly dispid 181; + property line: Integer readonly dispid 182; + property linepos: Integer readonly dispid 183; + property filepos: Integer readonly dispid 184; + end; + +// *********************************************************************// +// Interface: IXMLDOMDocument2 +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF95-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocument2 = interface(IXMLDOMDocument) + ['{2933BF95-7B36-11D2-B20E-00C04F983E60}'] + function Get_namespaces: IXMLDOMSchemaCollection; safecall; + function Get_schemas: OleVariant; safecall; + procedure _Set_schemas(otherCollection: OleVariant); safecall; + function validate: IXMLDOMParseError; safecall; + procedure setProperty(const name: WideString; value: OleVariant); safecall; + function getProperty(const name: WideString): OleVariant; safecall; + property namespaces: IXMLDOMSchemaCollection read Get_namespaces; + property schemas: OleVariant read Get_schemas write _Set_schemas; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocument2Disp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF95-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocument2Disp = dispinterface + ['{2933BF95-7B36-11D2-B20E-00C04F983E60}'] + property namespaces: IXMLDOMSchemaCollection readonly dispid 201; + property schemas: OleVariant dispid 202; + function validate: IXMLDOMParseError; dispid 203; + procedure setProperty(const name: WideString; value: OleVariant); dispid 204; + function getProperty(const name: WideString): OleVariant; dispid 205; + property doctype: IXMLDOMDocumentType readonly dispid 38; + property implementation_: IXMLDOMImplementation readonly dispid 39; + property documentElement: IXMLDOMElement dispid 40; + function createElement(const tagName: WideString): IXMLDOMElement; dispid 41; + function createDocumentFragment: IXMLDOMDocumentFragment; dispid 42; + function createTextNode(const data: WideString): IXMLDOMText; dispid 43; + function createComment(const data: WideString): IXMLDOMComment; dispid 44; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; dispid 45; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; dispid 46; + function createAttribute(const name: WideString): IXMLDOMAttribute; dispid 47; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; dispid 49; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; dispid 50; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 54; + function nodeFromID(const idString: WideString): IXMLDOMNode; dispid 56; + function load(xmlSource: OleVariant): WordBool; dispid 58; + property readyState: Integer readonly dispid -525; + property parseError: IXMLDOMParseError readonly dispid 59; + property url: WideString readonly dispid 60; + property async: WordBool dispid 61; + procedure abort; dispid 62; + function loadXML(const bstrXML: WideString): WordBool; dispid 63; + procedure save(destination: OleVariant); dispid 64; + property validateOnParse: WordBool dispid 65; + property resolveExternals: WordBool dispid 66; + property preserveWhiteSpace: WordBool dispid 67; + property onreadystatechange: OleVariant writeonly dispid 68; + property ondataavailable: OleVariant writeonly dispid 69; + property ontransformnode: OleVariant writeonly dispid 70; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMSchemaCollection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {373984C8-B845-449B-91E7-45AC83036ADE} +// *********************************************************************// + IXMLDOMSchemaCollection = interface(IDispatch) + ['{373984C8-B845-449B-91E7-45AC83036ADE}'] + procedure add(const namespaceURI: WideString; var_: OleVariant); safecall; + function get(const namespaceURI: WideString): IXMLDOMNode; safecall; + procedure remove(const namespaceURI: WideString); safecall; + function Get_length: Integer; safecall; + function Get_namespaceURI(index: Integer): WideString; safecall; + procedure addCollection(const otherCollection: IXMLDOMSchemaCollection); safecall; + function Get__newEnum: IUnknown; safecall; + property length: Integer read Get_length; + property namespaceURI[index: Integer]: WideString read Get_namespaceURI; default; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMSchemaCollectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {373984C8-B845-449B-91E7-45AC83036ADE} +// *********************************************************************// + IXMLDOMSchemaCollectionDisp = dispinterface + ['{373984C8-B845-449B-91E7-45AC83036ADE}'] + procedure add(const namespaceURI: WideString; var_: OleVariant); dispid 3; + function get(const namespaceURI: WideString): IXMLDOMNode; dispid 4; + procedure remove(const namespaceURI: WideString); dispid 5; + property length: Integer readonly dispid 6; + property namespaceURI[index: Integer]: WideString readonly dispid 0; default; + procedure addCollection(const otherCollection: IXMLDOMSchemaCollection); dispid 8; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: IXMLDOMDocument3 +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF96-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocument3 = interface(IXMLDOMDocument2) + ['{2933BF96-7B36-11D2-B20E-00C04F983E60}'] + function validateNode(const node: IXMLDOMNode): IXMLDOMParseError; safecall; + function importNode(const node: IXMLDOMNode; deep: WordBool): IXMLDOMNode; safecall; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMDocument3Disp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF96-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMDocument3Disp = dispinterface + ['{2933BF96-7B36-11D2-B20E-00C04F983E60}'] + function validateNode(const node: IXMLDOMNode): IXMLDOMParseError; dispid 208; + function importNode(const node: IXMLDOMNode; deep: WordBool): IXMLDOMNode; dispid 209; + property namespaces: IXMLDOMSchemaCollection readonly dispid 201; + property schemas: OleVariant dispid 202; + function validate: IXMLDOMParseError; dispid 203; + procedure setProperty(const name: WideString; value: OleVariant); dispid 204; + function getProperty(const name: WideString): OleVariant; dispid 205; + property doctype: IXMLDOMDocumentType readonly dispid 38; + property implementation_: IXMLDOMImplementation readonly dispid 39; + property documentElement: IXMLDOMElement dispid 40; + function createElement(const tagName: WideString): IXMLDOMElement; dispid 41; + function createDocumentFragment: IXMLDOMDocumentFragment; dispid 42; + function createTextNode(const data: WideString): IXMLDOMText; dispid 43; + function createComment(const data: WideString): IXMLDOMComment; dispid 44; + function createCDATASection(const data: WideString): IXMLDOMCDATASection; dispid 45; + function createProcessingInstruction(const target: WideString; const data: WideString): IXMLDOMProcessingInstruction; dispid 46; + function createAttribute(const name: WideString): IXMLDOMAttribute; dispid 47; + function createEntityReference(const name: WideString): IXMLDOMEntityReference; dispid 49; + function getElementsByTagName(const tagName: WideString): IXMLDOMNodeList; dispid 50; + function createNode(type_: OleVariant; const name: WideString; const namespaceURI: WideString): IXMLDOMNode; dispid 54; + function nodeFromID(const idString: WideString): IXMLDOMNode; dispid 56; + function load(xmlSource: OleVariant): WordBool; dispid 58; + property readyState: Integer readonly dispid -525; + property parseError: IXMLDOMParseError readonly dispid 59; + property url: WideString readonly dispid 60; + property async: WordBool dispid 61; + procedure abort; dispid 62; + function loadXML(const bstrXML: WideString): WordBool; dispid 63; + procedure save(destination: OleVariant); dispid 64; + property validateOnParse: WordBool dispid 65; + property resolveExternals: WordBool dispid 66; + property preserveWhiteSpace: WordBool dispid 67; + property onreadystatechange: OleVariant writeonly dispid 68; + property ondataavailable: OleVariant writeonly dispid 69; + property ontransformnode: OleVariant writeonly dispid 70; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMNotation +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8C-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNotation = interface(IXMLDOMNode) + ['{2933BF8C-7B36-11D2-B20E-00C04F983E60}'] + function Get_publicId: OleVariant; safecall; + function Get_systemId: OleVariant; safecall; + property publicId: OleVariant read Get_publicId; + property systemId: OleVariant read Get_systemId; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMNotationDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8C-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMNotationDisp = dispinterface + ['{2933BF8C-7B36-11D2-B20E-00C04F983E60}'] + property publicId: OleVariant readonly dispid 136; + property systemId: OleVariant readonly dispid 137; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMEntity +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8D-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntity = interface(IXMLDOMNode) + ['{2933BF8D-7B36-11D2-B20E-00C04F983E60}'] + function Get_publicId: OleVariant; safecall; + function Get_systemId: OleVariant; safecall; + function Get_notationName: WideString; safecall; + property publicId: OleVariant read Get_publicId; + property systemId: OleVariant read Get_systemId; + property notationName: WideString read Get_notationName; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMEntityDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF8D-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXMLDOMEntityDisp = dispinterface + ['{2933BF8D-7B36-11D2-B20E-00C04F983E60}'] + property publicId: OleVariant readonly dispid 140; + property systemId: OleVariant readonly dispid 141; + property notationName: WideString readonly dispid 142; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXMLDOMParseError2 +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA428-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseError2 = interface(IXMLDOMParseError) + ['{3EFAA428-272F-11D2-836F-0000F87A7782}'] + function Get_errorXPath: WideString; safecall; + function Get_allErrors: IXMLDOMParseErrorCollection; safecall; + function errorParameters(index: Integer): WideString; safecall; + function Get_errorParametersCount: Integer; safecall; + property errorXPath: WideString read Get_errorXPath; + property allErrors: IXMLDOMParseErrorCollection read Get_allErrors; + property errorParametersCount: Integer read Get_errorParametersCount; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMParseError2Disp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA428-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseError2Disp = dispinterface + ['{3EFAA428-272F-11D2-836F-0000F87A7782}'] + property errorXPath: WideString readonly dispid 190; + property allErrors: IXMLDOMParseErrorCollection readonly dispid 187; + function errorParameters(index: Integer): WideString; dispid 188; + property errorParametersCount: Integer readonly dispid 189; + property errorCode: Integer readonly dispid 0; + property url: WideString readonly dispid 179; + property reason: WideString readonly dispid 180; + property srcText: WideString readonly dispid 181; + property line: Integer readonly dispid 182; + property linepos: Integer readonly dispid 183; + property filepos: Integer readonly dispid 184; + end; + +// *********************************************************************// +// Interface: IXMLDOMParseErrorCollection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA429-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseErrorCollection = interface(IDispatch) + ['{3EFAA429-272F-11D2-836F-0000F87A7782}'] + function Get_item(index: Integer): IXMLDOMParseError2; safecall; + function Get_length: Integer; safecall; + function Get_next: IXMLDOMParseError2; safecall; + procedure reset; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: IXMLDOMParseError2 read Get_item; default; + property length: Integer read Get_length; + property next: IXMLDOMParseError2 read Get_next; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMParseErrorCollectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA429-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXMLDOMParseErrorCollectionDisp = dispinterface + ['{3EFAA429-272F-11D2-836F-0000F87A7782}'] + property item[index: Integer]: IXMLDOMParseError2 readonly dispid 0; default; + property length: Integer readonly dispid 193; + property next: IXMLDOMParseError2 readonly dispid 194; + procedure reset; dispid 195; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: IXTLRuntime +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA425-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXTLRuntime = interface(IXMLDOMNode) + ['{3EFAA425-272F-11D2-836F-0000F87A7782}'] + function uniqueID(const pNode: IXMLDOMNode): Integer; safecall; + function depth(const pNode: IXMLDOMNode): Integer; safecall; + function childNumber(const pNode: IXMLDOMNode): Integer; safecall; + function ancestorChildNumber(const bstrNodeName: WideString; const pNode: IXMLDOMNode): Integer; safecall; + function absoluteChildNumber(const pNode: IXMLDOMNode): Integer; safecall; + function formatIndex(lIndex: Integer; const bstrFormat: WideString): WideString; safecall; + function formatNumber(dblNumber: Double; const bstrFormat: WideString): WideString; safecall; + function formatDate(varDate: OleVariant; const bstrFormat: WideString; varDestLocale: OleVariant): WideString; safecall; + function formatTime(varTime: OleVariant; const bstrFormat: WideString; varDestLocale: OleVariant): WideString; safecall; + end; + +// *********************************************************************// +// DispIntf: IXTLRuntimeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {3EFAA425-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + IXTLRuntimeDisp = dispinterface + ['{3EFAA425-272F-11D2-836F-0000F87A7782}'] + function uniqueID(const pNode: IXMLDOMNode): Integer; dispid 187; + function depth(const pNode: IXMLDOMNode): Integer; dispid 188; + function childNumber(const pNode: IXMLDOMNode): Integer; dispid 189; + function ancestorChildNumber(const bstrNodeName: WideString; const pNode: IXMLDOMNode): Integer; dispid 190; + function absoluteChildNumber(const pNode: IXMLDOMNode): Integer; dispid 191; + function formatIndex(lIndex: Integer; const bstrFormat: WideString): WideString; dispid 192; + function formatNumber(dblNumber: Double; const bstrFormat: WideString): WideString; dispid 193; + function formatDate(varDate: OleVariant; const bstrFormat: WideString; varDestLocale: OleVariant): WideString; dispid 194; + function formatTime(varTime: OleVariant; const bstrFormat: WideString; varDestLocale: OleVariant): WideString; dispid 195; + property nodeName: WideString readonly dispid 2; + property nodeValue: OleVariant dispid 3; + property nodeType: DOMNodeType readonly dispid 4; + property parentNode: IXMLDOMNode readonly dispid 6; + property childNodes: IXMLDOMNodeList readonly dispid 7; + property firstChild: IXMLDOMNode readonly dispid 8; + property lastChild: IXMLDOMNode readonly dispid 9; + property previousSibling: IXMLDOMNode readonly dispid 10; + property nextSibling: IXMLDOMNode readonly dispid 11; + property attributes: IXMLDOMNamedNodeMap readonly dispid 12; + function insertBefore(const newChild: IXMLDOMNode; refChild: OleVariant): IXMLDOMNode; dispid 13; + function replaceChild(const newChild: IXMLDOMNode; const oldChild: IXMLDOMNode): IXMLDOMNode; dispid 14; + function removeChild(const childNode: IXMLDOMNode): IXMLDOMNode; dispid 15; + function appendChild(const newChild: IXMLDOMNode): IXMLDOMNode; dispid 16; + function hasChildNodes: WordBool; dispid 17; + property ownerDocument: IXMLDOMDocument readonly dispid 18; + function cloneNode(deep: WordBool): IXMLDOMNode; dispid 19; + property nodeTypeString: WideString readonly dispid 21; + property text: WideString dispid 24; + property specified: WordBool readonly dispid 22; + property definition: IXMLDOMNode readonly dispid 23; + property nodeTypedValue: OleVariant dispid 25; + function dataType: OleVariant; dispid 26; + property xml: WideString readonly dispid 27; + function transformNode(const stylesheet: IXMLDOMNode): WideString; dispid 28; + function selectNodes(const queryString: WideString): IXMLDOMNodeList; dispid 29; + function selectSingleNode(const queryString: WideString): IXMLDOMNode; dispid 30; + property parsed: WordBool readonly dispid 31; + property namespaceURI: WideString readonly dispid 32; + property prefix: WideString readonly dispid 33; + property baseName: WideString readonly dispid 34; + procedure transformNodeToObject(const stylesheet: IXMLDOMNode; outputObject: OleVariant); dispid 35; + end; + +// *********************************************************************// +// Interface: IXSLTemplate +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF93-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXSLTemplate = interface(IDispatch) + ['{2933BF93-7B36-11D2-B20E-00C04F983E60}'] + procedure _Set_stylesheet(const stylesheet: IXMLDOMNode); safecall; + function Get_stylesheet: IXMLDOMNode; safecall; + function createProcessor: IXSLProcessor; safecall; + property stylesheet: IXMLDOMNode read Get_stylesheet write _Set_stylesheet; + end; + +// *********************************************************************// +// DispIntf: IXSLTemplateDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF93-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXSLTemplateDisp = dispinterface + ['{2933BF93-7B36-11D2-B20E-00C04F983E60}'] + property stylesheet: IXMLDOMNode dispid 2; + function createProcessor: IXSLProcessor; dispid 3; + end; + +// *********************************************************************// +// Interface: IXSLProcessor +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF92-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXSLProcessor = interface(IDispatch) + ['{2933BF92-7B36-11D2-B20E-00C04F983E60}'] + procedure Set_input(pVar: OleVariant); safecall; + function Get_input: OleVariant; safecall; + function Get_ownerTemplate: IXSLTemplate; safecall; + procedure setStartMode(const mode: WideString; const namespaceURI: WideString); safecall; + function Get_startMode: WideString; safecall; + function Get_startModeURI: WideString; safecall; + procedure Set_output(pOutput: OleVariant); safecall; + function Get_output: OleVariant; safecall; + function transform: WordBool; safecall; + procedure reset; safecall; + function Get_readyState: Integer; safecall; + procedure addParameter(const baseName: WideString; parameter: OleVariant; + const namespaceURI: WideString); safecall; + procedure addObject(const obj: IDispatch; const namespaceURI: WideString); safecall; + function Get_stylesheet: IXMLDOMNode; safecall; + property input: OleVariant read Get_input write Set_input; + property ownerTemplate: IXSLTemplate read Get_ownerTemplate; + property startMode: WideString read Get_startMode; + property startModeURI: WideString read Get_startModeURI; + property output: OleVariant read Get_output write Set_output; + property readyState: Integer read Get_readyState; + property stylesheet: IXMLDOMNode read Get_stylesheet; + end; + +// *********************************************************************// +// DispIntf: IXSLProcessorDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2933BF92-7B36-11D2-B20E-00C04F983E60} +// *********************************************************************// + IXSLProcessorDisp = dispinterface + ['{2933BF92-7B36-11D2-B20E-00C04F983E60}'] + property input: OleVariant dispid 2; + property ownerTemplate: IXSLTemplate readonly dispid 3; + procedure setStartMode(const mode: WideString; const namespaceURI: WideString); dispid 4; + property startMode: WideString readonly dispid 5; + property startModeURI: WideString readonly dispid 6; + property output: OleVariant dispid 7; + function transform: WordBool; dispid 8; + procedure reset; dispid 9; + property readyState: Integer readonly dispid 10; + procedure addParameter(const baseName: WideString; parameter: OleVariant; + const namespaceURI: WideString); dispid 11; + procedure addObject(const obj: IDispatch; const namespaceURI: WideString); dispid 12; + property stylesheet: IXMLDOMNode readonly dispid 13; + end; + +// *********************************************************************// +// Interface: ISAXXMLReader +// Flags: (16) Hidden +// GUID: {A4F96ED0-F829-476E-81C0-CDC7BD2A0802} +// *********************************************************************// + ISAXXMLReader = interface(IUnknown) + ['{A4F96ED0-F829-476E-81C0-CDC7BD2A0802}'] + function getFeature(var pwchName: Word; out pvfValue: WordBool): HResult; stdcall; + function putFeature(var pwchName: Word; vfValue: WordBool): HResult; stdcall; + function getProperty(var pwchName: Word; out pvarValue: OleVariant): HResult; stdcall; + function putProperty(var pwchName: Word; varValue: OleVariant): HResult; stdcall; + function getEntityResolver(out ppResolver: ISAXEntityResolver): HResult; stdcall; + function putEntityResolver(const pResolver: ISAXEntityResolver): HResult; stdcall; + function getContentHandler(out ppHandler: ISAXContentHandler): HResult; stdcall; + function putContentHandler(const pHandler: ISAXContentHandler): HResult; stdcall; + function getDTDHandler(out ppHandler: ISAXDTDHandler): HResult; stdcall; + function putDTDHandler(const pHandler: ISAXDTDHandler): HResult; stdcall; + function getErrorHandler(out ppHandler: ISAXErrorHandler): HResult; stdcall; + function putErrorHandler(const pHandler: ISAXErrorHandler): HResult; stdcall; + function getBaseURL(out ppwchBaseUrl: PWord1): HResult; stdcall; + function putBaseURL(var pwchBaseUrl: Word): HResult; stdcall; + function getSecureBaseURL(out ppwchSecureBaseUrl: PWord1): HResult; stdcall; + function putSecureBaseURL(var pwchSecureBaseUrl: Word): HResult; stdcall; + function parse(varInput: OleVariant): HResult; stdcall; + function parseURL(var pwchUrl: Word): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXEntityResolver +// Flags: (16) Hidden +// GUID: {99BCA7BD-E8C4-4D5F-A0CF-6D907901FF07} +// *********************************************************************// + ISAXEntityResolver = interface(IUnknown) + ['{99BCA7BD-E8C4-4D5F-A0CF-6D907901FF07}'] + function resolveEntity(var pwchPublicId: Word; var pwchSystemId: Word; out pvarInput: OleVariant): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXContentHandler +// Flags: (16) Hidden +// GUID: {1545CDFA-9E4E-4497-A8A4-2BF7D0112C44} +// *********************************************************************// + ISAXContentHandler = interface(IUnknown) + ['{1545CDFA-9E4E-4497-A8A4-2BF7D0112C44}'] + function putDocumentLocator(const pLocator: ISAXLocator): HResult; stdcall; + function startDocument: HResult; stdcall; + function endDocument: HResult; stdcall; + function startPrefixMapping(var pwchPrefix: Word; cchPrefix: SYSINT; var pwchUri: Word; + cchUri: SYSINT): HResult; stdcall; + function endPrefixMapping(var pwchPrefix: Word; cchPrefix: SYSINT): HResult; stdcall; + function startElement(var pwchNamespaceUri: Word; cchNamespaceUri: SYSINT; + var pwchLocalName: Word; cchLocalName: SYSINT; var pwchQName: Word; + cchQName: SYSINT; const pAttributes: ISAXAttributes): HResult; stdcall; + function endElement(var pwchNamespaceUri: Word; cchNamespaceUri: SYSINT; + var pwchLocalName: Word; cchLocalName: SYSINT; var pwchQName: Word; + cchQName: SYSINT): HResult; stdcall; + function characters(var pwchChars: Word; cchChars: SYSINT): HResult; stdcall; + function ignorableWhitespace(var pwchChars: Word; cchChars: SYSINT): HResult; stdcall; + function processingInstruction(var pwchTarget: Word; cchTarget: SYSINT; var pwchData: Word; + cchData: SYSINT): HResult; stdcall; + function skippedEntity(var pwchName: Word; cchName: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXLocator +// Flags: (16) Hidden +// GUID: {9B7E472A-0DE4-4640-BFF3-84D38A051C31} +// *********************************************************************// + ISAXLocator = interface(IUnknown) + ['{9B7E472A-0DE4-4640-BFF3-84D38A051C31}'] + function getColumnNumber(out pnColumn: SYSINT): HResult; stdcall; + function getLineNumber(out pnLine: SYSINT): HResult; stdcall; + function getPublicId(out ppwchPublicId: PWord1): HResult; stdcall; + function getSystemId(out ppwchSystemId: PWord1): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXAttributes +// Flags: (16) Hidden +// GUID: {F078ABE1-45D2-4832-91EA-4466CE2F25C9} +// *********************************************************************// + ISAXAttributes = interface(IUnknown) + ['{F078ABE1-45D2-4832-91EA-4466CE2F25C9}'] + function getLength(out pnLength: SYSINT): HResult; stdcall; + function getURI(nIndex: SYSINT; out ppwchUri: PWord1; out pcchUri: SYSINT): HResult; stdcall; + function getLocalName(nIndex: SYSINT; out ppwchLocalName: PWord1; out pcchLocalName: SYSINT): HResult; stdcall; + function getQName(nIndex: SYSINT; out ppwchQName: PWord1; out pcchQName: SYSINT): HResult; stdcall; + function getName(nIndex: SYSINT; out ppwchUri: PWord1; out pcchUri: SYSINT; + out ppwchLocalName: PWord1; out pcchLocalName: SYSINT; out ppwchQName: PWord1; + out pcchQName: SYSINT): HResult; stdcall; + function getIndexFromName(var pwchUri: Word; cchUri: SYSINT; var pwchLocalName: Word; + cchLocalName: SYSINT; out pnIndex: SYSINT): HResult; stdcall; + function getIndexFromQName(var pwchQName: Word; cchQName: SYSINT; out pnIndex: SYSINT): HResult; stdcall; + function getType(nIndex: SYSINT; out ppwchType: PWord1; out pcchType: SYSINT): HResult; stdcall; + function getTypeFromName(var pwchUri: Word; cchUri: SYSINT; var pwchLocalName: Word; + cchLocalName: SYSINT; out ppwchType: PWord1; out pcchType: SYSINT): HResult; stdcall; + function getTypeFromQName(var pwchQName: Word; cchQName: SYSINT; out ppwchType: PWord1; + out pcchType: SYSINT): HResult; stdcall; + function getValue(nIndex: SYSINT; out ppwchValue: PWord1; out pcchValue: SYSINT): HResult; stdcall; + function getValueFromName(var pwchUri: Word; cchUri: SYSINT; var pwchLocalName: Word; + cchLocalName: SYSINT; out ppwchValue: PWord1; out pcchValue: SYSINT): HResult; stdcall; + function getValueFromQName(var pwchQName: Word; cchQName: SYSINT; out ppwchValue: PWord1; + out pcchValue: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXDTDHandler +// Flags: (16) Hidden +// GUID: {E15C1BAF-AFB3-4D60-8C36-19A8C45DEFED} +// *********************************************************************// + ISAXDTDHandler = interface(IUnknown) + ['{E15C1BAF-AFB3-4D60-8C36-19A8C45DEFED}'] + function notationDecl(var pwchName: Word; cchName: SYSINT; var pwchPublicId: Word; + cchPublicId: SYSINT; var pwchSystemId: Word; cchSystemId: SYSINT): HResult; stdcall; + function unparsedEntityDecl(var pwchName: Word; cchName: SYSINT; var pwchPublicId: Word; + cchPublicId: SYSINT; var pwchSystemId: Word; cchSystemId: SYSINT; + var pwchNotationName: Word; cchNotationName: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXErrorHandler +// Flags: (16) Hidden +// GUID: {A60511C4-CCF5-479E-98A3-DC8DC545B7D0} +// *********************************************************************// + ISAXErrorHandler = interface(IUnknown) + ['{A60511C4-CCF5-479E-98A3-DC8DC545B7D0}'] + function error(const pLocator: ISAXLocator; var pwchErrorMessage: Word; hrErrorCode: HResult): HResult; stdcall; + function fatalError(const pLocator: ISAXLocator; var pwchErrorMessage: Word; + hrErrorCode: HResult): HResult; stdcall; + function ignorableWarning(const pLocator: ISAXLocator; var pwchErrorMessage: Word; + hrErrorCode: HResult): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXXMLFilter +// Flags: (16) Hidden +// GUID: {70409222-CA09-4475-ACB8-40312FE8D145} +// *********************************************************************// + ISAXXMLFilter = interface(ISAXXMLReader) + ['{70409222-CA09-4475-ACB8-40312FE8D145}'] + function getParent(out ppReader: ISAXXMLReader): HResult; stdcall; + function putParent(const pReader: ISAXXMLReader): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXLexicalHandler +// Flags: (16) Hidden +// GUID: {7F85D5F5-47A8-4497-BDA5-84BA04819EA6} +// *********************************************************************// + ISAXLexicalHandler = interface(IUnknown) + ['{7F85D5F5-47A8-4497-BDA5-84BA04819EA6}'] + function startDTD(var pwchName: Word; cchName: SYSINT; var pwchPublicId: Word; + cchPublicId: SYSINT; var pwchSystemId: Word; cchSystemId: SYSINT): HResult; stdcall; + function endDTD: HResult; stdcall; + function startEntity(var pwchName: Word; cchName: SYSINT): HResult; stdcall; + function endEntity(var pwchName: Word; cchName: SYSINT): HResult; stdcall; + function startCDATA: HResult; stdcall; + function endCDATA: HResult; stdcall; + function comment(var pwchChars: Word; cchChars: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: ISAXDeclHandler +// Flags: (16) Hidden +// GUID: {862629AC-771A-47B2-8337-4E6843C1BE90} +// *********************************************************************// + ISAXDeclHandler = interface(IUnknown) + ['{862629AC-771A-47B2-8337-4E6843C1BE90}'] + function elementDecl(var pwchName: Word; cchName: SYSINT; var pwchModel: Word; cchModel: SYSINT): HResult; stdcall; + function attributeDecl(var pwchElementName: Word; cchElementName: SYSINT; + var pwchAttributeName: Word; cchAttributeName: SYSINT; + var pwchType: Word; cchType: SYSINT; var pwchValueDefault: Word; + cchValueDefault: SYSINT; var pwchValue: Word; cchValue: SYSINT): HResult; stdcall; + function internalEntityDecl(var pwchName: Word; cchName: SYSINT; var pwchValue: Word; + cchValue: SYSINT): HResult; stdcall; + function externalEntityDecl(var pwchName: Word; cchName: SYSINT; var pwchPublicId: Word; + cchPublicId: SYSINT; var pwchSystemId: Word; cchSystemId: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// Interface: IVBSAXXMLReader +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {8C033CAA-6CD6-4F73-B728-4531AF74945F} +// *********************************************************************// + IVBSAXXMLReader = interface(IDispatch) + ['{8C033CAA-6CD6-4F73-B728-4531AF74945F}'] + function getFeature(const strName: WideString): WordBool; safecall; + procedure putFeature(const strName: WideString; fValue: WordBool); safecall; + function getProperty(const strName: WideString): OleVariant; safecall; + procedure putProperty(const strName: WideString; varValue: OleVariant); safecall; + function Get_entityResolver: IVBSAXEntityResolver; safecall; + procedure _Set_entityResolver(const oResolver: IVBSAXEntityResolver); safecall; + function Get_contentHandler: IVBSAXContentHandler; safecall; + procedure _Set_contentHandler(const oHandler: IVBSAXContentHandler); safecall; + function Get_dtdHandler: IVBSAXDTDHandler; safecall; + procedure _Set_dtdHandler(const oHandler: IVBSAXDTDHandler); safecall; + function Get_errorHandler: IVBSAXErrorHandler; safecall; + procedure _Set_errorHandler(const oHandler: IVBSAXErrorHandler); safecall; + function Get_baseURL: WideString; safecall; + procedure Set_baseURL(const strBaseURL: WideString); safecall; + function Get_secureBaseURL: WideString; safecall; + procedure Set_secureBaseURL(const strSecureBaseURL: WideString); safecall; + procedure parse(varInput: OleVariant); safecall; + procedure parseURL(const strURL: WideString); safecall; + property entityResolver: IVBSAXEntityResolver read Get_entityResolver write _Set_entityResolver; + property contentHandler: IVBSAXContentHandler read Get_contentHandler write _Set_contentHandler; + property dtdHandler: IVBSAXDTDHandler read Get_dtdHandler write _Set_dtdHandler; + property errorHandler: IVBSAXErrorHandler read Get_errorHandler write _Set_errorHandler; + property baseURL: WideString read Get_baseURL write Set_baseURL; + property secureBaseURL: WideString read Get_secureBaseURL write Set_secureBaseURL; + end; + +// *********************************************************************// +// DispIntf: IVBSAXXMLReaderDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {8C033CAA-6CD6-4F73-B728-4531AF74945F} +// *********************************************************************// + IVBSAXXMLReaderDisp = dispinterface + ['{8C033CAA-6CD6-4F73-B728-4531AF74945F}'] + function getFeature(const strName: WideString): WordBool; dispid 1282; + procedure putFeature(const strName: WideString; fValue: WordBool); dispid 1283; + function getProperty(const strName: WideString): OleVariant; dispid 1284; + procedure putProperty(const strName: WideString; varValue: OleVariant); dispid 1285; + property entityResolver: IVBSAXEntityResolver dispid 1286; + property contentHandler: IVBSAXContentHandler dispid 1287; + property dtdHandler: IVBSAXDTDHandler dispid 1288; + property errorHandler: IVBSAXErrorHandler dispid 1289; + property baseURL: WideString dispid 1290; + property secureBaseURL: WideString dispid 1291; + procedure parse(varInput: OleVariant); dispid 1292; + procedure parseURL(const strURL: WideString); dispid 1293; + end; + +// *********************************************************************// +// Interface: IVBSAXEntityResolver +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {0C05D096-F45B-4ACA-AD1A-AA0BC25518DC} +// *********************************************************************// + IVBSAXEntityResolver = interface(IDispatch) + ['{0C05D096-F45B-4ACA-AD1A-AA0BC25518DC}'] + function resolveEntity(var strPublicId: WideString; var strSystemId: WideString): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IVBSAXEntityResolverDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {0C05D096-F45B-4ACA-AD1A-AA0BC25518DC} +// *********************************************************************// + IVBSAXEntityResolverDisp = dispinterface + ['{0C05D096-F45B-4ACA-AD1A-AA0BC25518DC}'] + function resolveEntity(var strPublicId: WideString; var strSystemId: WideString): OleVariant; dispid 1319; + end; + +// *********************************************************************// +// Interface: IVBSAXContentHandler +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2ED7290A-4DD5-4B46-BB26-4E4155E77FAA} +// *********************************************************************// + IVBSAXContentHandler = interface(IDispatch) + ['{2ED7290A-4DD5-4B46-BB26-4E4155E77FAA}'] + procedure _Set_documentLocator(const Param1: IVBSAXLocator); safecall; + procedure startDocument; safecall; + procedure endDocument; safecall; + procedure startPrefixMapping(var strPrefix: WideString; var strURI: WideString); safecall; + procedure endPrefixMapping(var strPrefix: WideString); safecall; + procedure startElement(var strNamespaceURI: WideString; var strLocalName: WideString; + var strQName: WideString; const oAttributes: IVBSAXAttributes); safecall; + procedure endElement(var strNamespaceURI: WideString; var strLocalName: WideString; + var strQName: WideString); safecall; + procedure characters(var strChars: WideString); safecall; + procedure ignorableWhitespace(var strChars: WideString); safecall; + procedure processingInstruction(var strTarget: WideString; var strData: WideString); safecall; + procedure skippedEntity(var strName: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IVBSAXContentHandlerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {2ED7290A-4DD5-4B46-BB26-4E4155E77FAA} +// *********************************************************************// + IVBSAXContentHandlerDisp = dispinterface + ['{2ED7290A-4DD5-4B46-BB26-4E4155E77FAA}'] + procedure startDocument; dispid 1323; + procedure endDocument; dispid 1324; + procedure startPrefixMapping(var strPrefix: WideString; var strURI: WideString); dispid 1325; + procedure endPrefixMapping(var strPrefix: WideString); dispid 1326; + procedure startElement(var strNamespaceURI: WideString; var strLocalName: WideString; + var strQName: WideString; const oAttributes: IVBSAXAttributes); dispid 1327; + procedure endElement(var strNamespaceURI: WideString; var strLocalName: WideString; + var strQName: WideString); dispid 1328; + procedure characters(var strChars: WideString); dispid 1329; + procedure ignorableWhitespace(var strChars: WideString); dispid 1330; + procedure processingInstruction(var strTarget: WideString; var strData: WideString); dispid 1331; + procedure skippedEntity(var strName: WideString); dispid 1332; + end; + +// *********************************************************************// +// Interface: IVBSAXLocator +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {796E7AC5-5AA2-4EFF-ACAD-3FAAF01A3288} +// *********************************************************************// + IVBSAXLocator = interface(IDispatch) + ['{796E7AC5-5AA2-4EFF-ACAD-3FAAF01A3288}'] + function Get_columnNumber: SYSINT; safecall; + function Get_lineNumber: SYSINT; safecall; + function Get_publicId: WideString; safecall; + function Get_systemId: WideString; safecall; + property columnNumber: SYSINT read Get_columnNumber; + property lineNumber: SYSINT read Get_lineNumber; + property publicId: WideString read Get_publicId; + property systemId: WideString read Get_systemId; + end; + +// *********************************************************************// +// DispIntf: IVBSAXLocatorDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {796E7AC5-5AA2-4EFF-ACAD-3FAAF01A3288} +// *********************************************************************// + IVBSAXLocatorDisp = dispinterface + ['{796E7AC5-5AA2-4EFF-ACAD-3FAAF01A3288}'] + property columnNumber: SYSINT readonly dispid 1313; + property lineNumber: SYSINT readonly dispid 1314; + property publicId: WideString readonly dispid 1315; + property systemId: WideString readonly dispid 1316; + end; + +// *********************************************************************// +// Interface: IVBSAXAttributes +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {10DC0586-132B-4CAC-8BB3-DB00AC8B7EE0} +// *********************************************************************// + IVBSAXAttributes = interface(IDispatch) + ['{10DC0586-132B-4CAC-8BB3-DB00AC8B7EE0}'] + function Get_length: SYSINT; safecall; + function getURI(nIndex: SYSINT): WideString; safecall; + function getLocalName(nIndex: SYSINT): WideString; safecall; + function getQName(nIndex: SYSINT): WideString; safecall; + function getIndexFromName(const strURI: WideString; const strLocalName: WideString): SYSINT; safecall; + function getIndexFromQName(const strQName: WideString): SYSINT; safecall; + function getType(nIndex: SYSINT): WideString; safecall; + function getTypeFromName(const strURI: WideString; const strLocalName: WideString): WideString; safecall; + function getTypeFromQName(const strQName: WideString): WideString; safecall; + function getValue(nIndex: SYSINT): WideString; safecall; + function getValueFromName(const strURI: WideString; const strLocalName: WideString): WideString; safecall; + function getValueFromQName(const strQName: WideString): WideString; safecall; + property length: SYSINT read Get_length; + end; + +// *********************************************************************// +// DispIntf: IVBSAXAttributesDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {10DC0586-132B-4CAC-8BB3-DB00AC8B7EE0} +// *********************************************************************// + IVBSAXAttributesDisp = dispinterface + ['{10DC0586-132B-4CAC-8BB3-DB00AC8B7EE0}'] + property length: SYSINT readonly dispid 1344; + function getURI(nIndex: SYSINT): WideString; dispid 1345; + function getLocalName(nIndex: SYSINT): WideString; dispid 1346; + function getQName(nIndex: SYSINT): WideString; dispid 1347; + function getIndexFromName(const strURI: WideString; const strLocalName: WideString): SYSINT; dispid 1348; + function getIndexFromQName(const strQName: WideString): SYSINT; dispid 1349; + function getType(nIndex: SYSINT): WideString; dispid 1350; + function getTypeFromName(const strURI: WideString; const strLocalName: WideString): WideString; dispid 1351; + function getTypeFromQName(const strQName: WideString): WideString; dispid 1352; + function getValue(nIndex: SYSINT): WideString; dispid 1353; + function getValueFromName(const strURI: WideString; const strLocalName: WideString): WideString; dispid 1354; + function getValueFromQName(const strQName: WideString): WideString; dispid 1355; + end; + +// *********************************************************************// +// Interface: IVBSAXDTDHandler +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {24FB3297-302D-4620-BA39-3A732D850558} +// *********************************************************************// + IVBSAXDTDHandler = interface(IDispatch) + ['{24FB3297-302D-4620-BA39-3A732D850558}'] + procedure notationDecl(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString); safecall; + procedure unparsedEntityDecl(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString; var strNotationName: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IVBSAXDTDHandlerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {24FB3297-302D-4620-BA39-3A732D850558} +// *********************************************************************// + IVBSAXDTDHandlerDisp = dispinterface + ['{24FB3297-302D-4620-BA39-3A732D850558}'] + procedure notationDecl(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString); dispid 1335; + procedure unparsedEntityDecl(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString; var strNotationName: WideString); dispid 1336; + end; + +// *********************************************************************// +// Interface: IVBSAXErrorHandler +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {D963D3FE-173C-4862-9095-B92F66995F52} +// *********************************************************************// + IVBSAXErrorHandler = interface(IDispatch) + ['{D963D3FE-173C-4862-9095-B92F66995F52}'] + procedure error(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; + nErrorCode: Integer); safecall; + procedure fatalError(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; + nErrorCode: Integer); safecall; + procedure ignorableWarning(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; + nErrorCode: Integer); safecall; + end; + +// *********************************************************************// +// DispIntf: IVBSAXErrorHandlerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {D963D3FE-173C-4862-9095-B92F66995F52} +// *********************************************************************// + IVBSAXErrorHandlerDisp = dispinterface + ['{D963D3FE-173C-4862-9095-B92F66995F52}'] + procedure error(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; + nErrorCode: Integer); dispid 1339; + procedure fatalError(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; + nErrorCode: Integer); dispid 1340; + procedure ignorableWarning(const oLocator: IVBSAXLocator; var strErrorMessage: WideString; + nErrorCode: Integer); dispid 1341; + end; + +// *********************************************************************// +// Interface: IVBSAXXMLFilter +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {1299EB1B-5B88-433E-82DE-82CA75AD4E04} +// *********************************************************************// + IVBSAXXMLFilter = interface(IDispatch) + ['{1299EB1B-5B88-433E-82DE-82CA75AD4E04}'] + function Get_parent: IVBSAXXMLReader; safecall; + procedure _Set_parent(const oReader: IVBSAXXMLReader); safecall; + property parent: IVBSAXXMLReader read Get_parent write _Set_parent; + end; + +// *********************************************************************// +// DispIntf: IVBSAXXMLFilterDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {1299EB1B-5B88-433E-82DE-82CA75AD4E04} +// *********************************************************************// + IVBSAXXMLFilterDisp = dispinterface + ['{1299EB1B-5B88-433E-82DE-82CA75AD4E04}'] + property parent: IVBSAXXMLReader dispid 1309; + end; + +// *********************************************************************// +// Interface: IVBSAXLexicalHandler +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {032AAC35-8C0E-4D9D-979F-E3B702935576} +// *********************************************************************// + IVBSAXLexicalHandler = interface(IDispatch) + ['{032AAC35-8C0E-4D9D-979F-E3B702935576}'] + procedure startDTD(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString); safecall; + procedure endDTD; safecall; + procedure startEntity(var strName: WideString); safecall; + procedure endEntity(var strName: WideString); safecall; + procedure startCDATA; safecall; + procedure endCDATA; safecall; + procedure comment(var strChars: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IVBSAXLexicalHandlerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {032AAC35-8C0E-4D9D-979F-E3B702935576} +// *********************************************************************// + IVBSAXLexicalHandlerDisp = dispinterface + ['{032AAC35-8C0E-4D9D-979F-E3B702935576}'] + procedure startDTD(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString); dispid 1358; + procedure endDTD; dispid 1359; + procedure startEntity(var strName: WideString); dispid 1360; + procedure endEntity(var strName: WideString); dispid 1361; + procedure startCDATA; dispid 1362; + procedure endCDATA; dispid 1363; + procedure comment(var strChars: WideString); dispid 1364; + end; + +// *********************************************************************// +// Interface: IVBSAXDeclHandler +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {E8917260-7579-4BE1-B5DD-7AFBFA6F077B} +// *********************************************************************// + IVBSAXDeclHandler = interface(IDispatch) + ['{E8917260-7579-4BE1-B5DD-7AFBFA6F077B}'] + procedure elementDecl(var strName: WideString; var strModel: WideString); safecall; + procedure attributeDecl(var strElementName: WideString; var strAttributeName: WideString; + var strType: WideString; var strValueDefault: WideString; + var strValue: WideString); safecall; + procedure internalEntityDecl(var strName: WideString; var strValue: WideString); safecall; + procedure externalEntityDecl(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IVBSAXDeclHandlerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {E8917260-7579-4BE1-B5DD-7AFBFA6F077B} +// *********************************************************************// + IVBSAXDeclHandlerDisp = dispinterface + ['{E8917260-7579-4BE1-B5DD-7AFBFA6F077B}'] + procedure elementDecl(var strName: WideString; var strModel: WideString); dispid 1367; + procedure attributeDecl(var strElementName: WideString; var strAttributeName: WideString; + var strType: WideString; var strValueDefault: WideString; + var strValue: WideString); dispid 1368; + procedure internalEntityDecl(var strName: WideString; var strValue: WideString); dispid 1369; + procedure externalEntityDecl(var strName: WideString; var strPublicId: WideString; + var strSystemId: WideString); dispid 1370; + end; + +// *********************************************************************// +// Interface: IMXWriter +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {4D7FF4BA-1565-4EA8-94E1-6E724A46F98D} +// *********************************************************************// + IMXWriter = interface(IDispatch) + ['{4D7FF4BA-1565-4EA8-94E1-6E724A46F98D}'] + procedure Set_output(varDestination: OleVariant); safecall; + function Get_output: OleVariant; safecall; + procedure Set_encoding(const strEncoding: WideString); safecall; + function Get_encoding: WideString; safecall; + procedure Set_byteOrderMark(fWriteByteOrderMark: WordBool); safecall; + function Get_byteOrderMark: WordBool; safecall; + procedure Set_indent(fIndentMode: WordBool); safecall; + function Get_indent: WordBool; safecall; + procedure Set_standalone(fValue: WordBool); safecall; + function Get_standalone: WordBool; safecall; + procedure Set_omitXMLDeclaration(fValue: WordBool); safecall; + function Get_omitXMLDeclaration: WordBool; safecall; + procedure Set_version(const strVersion: WideString); safecall; + function Get_version: WideString; safecall; + procedure Set_disableOutputEscaping(fValue: WordBool); safecall; + function Get_disableOutputEscaping: WordBool; safecall; + procedure flush; safecall; + property output: OleVariant read Get_output write Set_output; + property encoding: WideString read Get_encoding write Set_encoding; + property byteOrderMark: WordBool read Get_byteOrderMark write Set_byteOrderMark; + property indent: WordBool read Get_indent write Set_indent; + property standalone: WordBool read Get_standalone write Set_standalone; + property omitXMLDeclaration: WordBool read Get_omitXMLDeclaration write Set_omitXMLDeclaration; + property version: WideString read Get_version write Set_version; + property disableOutputEscaping: WordBool read Get_disableOutputEscaping write Set_disableOutputEscaping; + end; + +// *********************************************************************// +// DispIntf: IMXWriterDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {4D7FF4BA-1565-4EA8-94E1-6E724A46F98D} +// *********************************************************************// + IMXWriterDisp = dispinterface + ['{4D7FF4BA-1565-4EA8-94E1-6E724A46F98D}'] + property output: OleVariant dispid 1385; + property encoding: WideString dispid 1387; + property byteOrderMark: WordBool dispid 1388; + property indent: WordBool dispid 1389; + property standalone: WordBool dispid 1390; + property omitXMLDeclaration: WordBool dispid 1391; + property version: WideString dispid 1392; + property disableOutputEscaping: WordBool dispid 1393; + procedure flush; dispid 1394; + end; + +// *********************************************************************// +// Interface: IMXAttributes +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {F10D27CC-3EC0-415C-8ED8-77AB1C5E7262} +// *********************************************************************// + IMXAttributes = interface(IDispatch) + ['{F10D27CC-3EC0-415C-8ED8-77AB1C5E7262}'] + procedure addAttribute(const strURI: WideString; const strLocalName: WideString; + const strQName: WideString; const strType: WideString; + const strValue: WideString); safecall; + procedure addAttributeFromIndex(varAtts: OleVariant; nIndex: SYSINT); safecall; + procedure clear; safecall; + procedure removeAttribute(nIndex: SYSINT); safecall; + procedure setAttribute(nIndex: SYSINT; const strURI: WideString; + const strLocalName: WideString; const strQName: WideString; + const strType: WideString; const strValue: WideString); safecall; + procedure setAttributes(varAtts: OleVariant); safecall; + procedure setLocalName(nIndex: SYSINT; const strLocalName: WideString); safecall; + procedure setQName(nIndex: SYSINT; const strQName: WideString); safecall; + procedure setType(nIndex: SYSINT; const strType: WideString); safecall; + procedure setURI(nIndex: SYSINT; const strURI: WideString); safecall; + procedure setValue(nIndex: SYSINT; const strValue: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IMXAttributesDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {F10D27CC-3EC0-415C-8ED8-77AB1C5E7262} +// *********************************************************************// + IMXAttributesDisp = dispinterface + ['{F10D27CC-3EC0-415C-8ED8-77AB1C5E7262}'] + procedure addAttribute(const strURI: WideString; const strLocalName: WideString; + const strQName: WideString; const strType: WideString; + const strValue: WideString); dispid 1373; + procedure addAttributeFromIndex(varAtts: OleVariant; nIndex: SYSINT); dispid 1383; + procedure clear; dispid 1374; + procedure removeAttribute(nIndex: SYSINT); dispid 1375; + procedure setAttribute(nIndex: SYSINT; const strURI: WideString; + const strLocalName: WideString; const strQName: WideString; + const strType: WideString; const strValue: WideString); dispid 1376; + procedure setAttributes(varAtts: OleVariant); dispid 1377; + procedure setLocalName(nIndex: SYSINT; const strLocalName: WideString); dispid 1378; + procedure setQName(nIndex: SYSINT; const strQName: WideString); dispid 1379; + procedure setType(nIndex: SYSINT; const strType: WideString); dispid 1380; + procedure setURI(nIndex: SYSINT; const strURI: WideString); dispid 1381; + procedure setValue(nIndex: SYSINT; const strValue: WideString); dispid 1382; + end; + +// *********************************************************************// +// Interface: IMXReaderControl +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {808F4E35-8D5A-4FBE-8466-33A41279ED30} +// *********************************************************************// + IMXReaderControl = interface(IDispatch) + ['{808F4E35-8D5A-4FBE-8466-33A41279ED30}'] + procedure abort; safecall; + procedure resume; safecall; + procedure suspend; safecall; + end; + +// *********************************************************************// +// DispIntf: IMXReaderControlDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {808F4E35-8D5A-4FBE-8466-33A41279ED30} +// *********************************************************************// + IMXReaderControlDisp = dispinterface + ['{808F4E35-8D5A-4FBE-8466-33A41279ED30}'] + procedure abort; dispid 1398; + procedure resume; dispid 1399; + procedure suspend; dispid 1400; + end; + +// *********************************************************************// +// Interface: IMXSchemaDeclHandler +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {FA4BB38C-FAF9-4CCA-9302-D1DD0FE520DB} +// *********************************************************************// + IMXSchemaDeclHandler = interface(IDispatch) + ['{FA4BB38C-FAF9-4CCA-9302-D1DD0FE520DB}'] + procedure schemaElementDecl(const oSchemaElement: ISchemaElement); safecall; + end; + +// *********************************************************************// +// DispIntf: IMXSchemaDeclHandlerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {FA4BB38C-FAF9-4CCA-9302-D1DD0FE520DB} +// *********************************************************************// + IMXSchemaDeclHandlerDisp = dispinterface + ['{FA4BB38C-FAF9-4CCA-9302-D1DD0FE520DB}'] + procedure schemaElementDecl(const oSchemaElement: ISchemaElement); dispid 1403; + end; + +// *********************************************************************// +// Interface: ISchemaItem +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B3-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaItem = interface(IDispatch) + ['{50EA08B3-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_name: WideString; safecall; + function Get_namespaceURI: WideString; safecall; + function Get_schema: ISchema; safecall; + function Get_id: WideString; safecall; + function Get_itemType: SOMITEMTYPE; safecall; + function Get_unhandledAttributes: IVBSAXAttributes; safecall; + function writeAnnotation(const annotationSink: IUnknown): WordBool; safecall; + property name: WideString read Get_name; + property namespaceURI: WideString read Get_namespaceURI; + property schema: ISchema read Get_schema; + property id: WideString read Get_id; + property itemType: SOMITEMTYPE read Get_itemType; + property unhandledAttributes: IVBSAXAttributes read Get_unhandledAttributes; + end; + +// *********************************************************************// +// DispIntf: ISchemaItemDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B3-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaItemDisp = dispinterface + ['{50EA08B3-DD1B-4664-9A50-C2F40F4BD79A}'] + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaParticle +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B5-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaParticle = interface(ISchemaItem) + ['{50EA08B5-DD1B-4664-9A50-C2F40F4BD79A}'] + procedure GhostMethod_ISchemaParticle_0_1; safecall; + procedure GhostMethod_ISchemaParticle_4_2; safecall; + procedure GhostMethod_ISchemaParticle_8_3; safecall; + procedure GhostMethod_ISchemaParticle_12_4; safecall; + procedure GhostMethod_ISchemaParticle_16_5; safecall; + procedure GhostMethod_ISchemaParticle_20_6; safecall; + procedure GhostMethod_ISchemaParticle_24_7; safecall; + procedure GhostMethod_ISchemaParticle_28_8; safecall; + procedure GhostMethod_ISchemaParticle_32_9; safecall; + procedure GhostMethod_ISchemaParticle_36_10; safecall; + procedure GhostMethod_ISchemaParticle_40_11; safecall; + procedure GhostMethod_ISchemaParticle_44_12; safecall; + procedure GhostMethod_ISchemaParticle_48_13; safecall; + procedure GhostMethod_ISchemaParticle_52_14; safecall; + function Get_minOccurs: OleVariant; safecall; + function Get_maxOccurs: OleVariant; safecall; + property minOccurs: OleVariant read Get_minOccurs; + property maxOccurs: OleVariant read Get_maxOccurs; + end; + +// *********************************************************************// +// DispIntf: ISchemaParticleDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B5-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaParticleDisp = dispinterface + ['{50EA08B5-DD1B-4664-9A50-C2F40F4BD79A}'] + procedure GhostMethod_ISchemaParticle_0_1; dispid 1610678272; + procedure GhostMethod_ISchemaParticle_4_2; dispid 1610678273; + procedure GhostMethod_ISchemaParticle_8_3; dispid 1610678274; + procedure GhostMethod_ISchemaParticle_12_4; dispid 1610678275; + procedure GhostMethod_ISchemaParticle_16_5; dispid 1610678276; + procedure GhostMethod_ISchemaParticle_20_6; dispid 1610678277; + procedure GhostMethod_ISchemaParticle_24_7; dispid 1610678278; + procedure GhostMethod_ISchemaParticle_28_8; dispid 1610678279; + procedure GhostMethod_ISchemaParticle_32_9; dispid 1610678280; + procedure GhostMethod_ISchemaParticle_36_10; dispid 1610678281; + procedure GhostMethod_ISchemaParticle_40_11; dispid 1610678282; + procedure GhostMethod_ISchemaParticle_44_12; dispid 1610678283; + procedure GhostMethod_ISchemaParticle_48_13; dispid 1610678284; + procedure GhostMethod_ISchemaParticle_52_14; dispid 1610678285; + property minOccurs: OleVariant readonly dispid 1455; + property maxOccurs: OleVariant readonly dispid 1451; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaElement +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B7-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaElement = interface(ISchemaParticle) + ['{50EA08B7-DD1B-4664-9A50-C2F40F4BD79A}'] + procedure GhostMethod_ISchemaElement_0_1; safecall; + procedure GhostMethod_ISchemaElement_4_2; safecall; + procedure GhostMethod_ISchemaElement_8_3; safecall; + procedure GhostMethod_ISchemaElement_12_4; safecall; + procedure GhostMethod_ISchemaElement_16_5; safecall; + procedure GhostMethod_ISchemaElement_20_6; safecall; + procedure GhostMethod_ISchemaElement_24_7; safecall; + procedure GhostMethod_ISchemaElement_28_8; safecall; + procedure GhostMethod_ISchemaElement_32_9; safecall; + procedure GhostMethod_ISchemaElement_36_10; safecall; + procedure GhostMethod_ISchemaElement_40_11; safecall; + procedure GhostMethod_ISchemaElement_44_12; safecall; + procedure GhostMethod_ISchemaElement_48_13; safecall; + procedure GhostMethod_ISchemaElement_52_14; safecall; + procedure GhostMethod_ISchemaElement_56_15; safecall; + procedure GhostMethod_ISchemaElement_60_16; safecall; + function Get_type_: ISchemaType; safecall; + function Get_scope: ISchemaComplexType; safecall; + function Get_defaultValue: WideString; safecall; + function Get_fixedValue: WideString; safecall; + function Get_isNillable: WordBool; safecall; + function Get_identityConstraints: ISchemaItemCollection; safecall; + function Get_substitutionGroup: ISchemaElement; safecall; + function Get_substitutionGroupExclusions: SCHEMADERIVATIONMETHOD; safecall; + function Get_disallowedSubstitutions: SCHEMADERIVATIONMETHOD; safecall; + function Get_isAbstract: WordBool; safecall; + function Get_isReference: WordBool; safecall; + property type_: ISchemaType read Get_type_; + property scope: ISchemaComplexType read Get_scope; + property defaultValue: WideString read Get_defaultValue; + property fixedValue: WideString read Get_fixedValue; + property isNillable: WordBool read Get_isNillable; + property identityConstraints: ISchemaItemCollection read Get_identityConstraints; + property substitutionGroup: ISchemaElement read Get_substitutionGroup; + property substitutionGroupExclusions: SCHEMADERIVATIONMETHOD read Get_substitutionGroupExclusions; + property disallowedSubstitutions: SCHEMADERIVATIONMETHOD read Get_disallowedSubstitutions; + property isAbstract: WordBool read Get_isAbstract; + property isReference: WordBool read Get_isReference; + end; + +// *********************************************************************// +// DispIntf: ISchemaElementDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B7-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaElementDisp = dispinterface + ['{50EA08B7-DD1B-4664-9A50-C2F40F4BD79A}'] + procedure GhostMethod_ISchemaElement_0_1; dispid 1610678272; + procedure GhostMethod_ISchemaElement_4_2; dispid 1610678273; + procedure GhostMethod_ISchemaElement_8_3; dispid 1610678274; + procedure GhostMethod_ISchemaElement_12_4; dispid 1610678275; + procedure GhostMethod_ISchemaElement_16_5; dispid 1610678276; + procedure GhostMethod_ISchemaElement_20_6; dispid 1610678277; + procedure GhostMethod_ISchemaElement_24_7; dispid 1610678278; + procedure GhostMethod_ISchemaElement_28_8; dispid 1610678279; + procedure GhostMethod_ISchemaElement_32_9; dispid 1610678280; + procedure GhostMethod_ISchemaElement_36_10; dispid 1610678281; + procedure GhostMethod_ISchemaElement_40_11; dispid 1610678282; + procedure GhostMethod_ISchemaElement_44_12; dispid 1610678283; + procedure GhostMethod_ISchemaElement_48_13; dispid 1610678284; + procedure GhostMethod_ISchemaElement_52_14; dispid 1610678285; + procedure GhostMethod_ISchemaElement_56_15; dispid 1610678286; + procedure GhostMethod_ISchemaElement_60_16; dispid 1610678287; + property type_: ISchemaType readonly dispid 1476; + property scope: ISchemaComplexType readonly dispid 1469; + property defaultValue: WideString readonly dispid 1431; + property fixedValue: WideString readonly dispid 1438; + property isNillable: WordBool readonly dispid 1443; + property identityConstraints: ISchemaItemCollection readonly dispid 1441; + property substitutionGroup: ISchemaElement readonly dispid 1471; + property substitutionGroupExclusions: SCHEMADERIVATIONMETHOD readonly dispid 1472; + property disallowedSubstitutions: SCHEMADERIVATIONMETHOD readonly dispid 1433; + property isAbstract: WordBool readonly dispid 1442; + property isReference: WordBool readonly dispid 1444; + procedure GhostMethod_ISchemaParticle_0_1; dispid 1610678272; + procedure GhostMethod_ISchemaParticle_4_2; dispid 1610678273; + procedure GhostMethod_ISchemaParticle_8_3; dispid 1610678274; + procedure GhostMethod_ISchemaParticle_12_4; dispid 1610678275; + procedure GhostMethod_ISchemaParticle_16_5; dispid 1610678276; + procedure GhostMethod_ISchemaParticle_20_6; dispid 1610678277; + procedure GhostMethod_ISchemaParticle_24_7; dispid 1610678278; + procedure GhostMethod_ISchemaParticle_28_8; dispid 1610678279; + procedure GhostMethod_ISchemaParticle_32_9; dispid 1610678280; + procedure GhostMethod_ISchemaParticle_36_10; dispid 1610678281; + procedure GhostMethod_ISchemaParticle_40_11; dispid 1610678282; + procedure GhostMethod_ISchemaParticle_44_12; dispid 1610678283; + procedure GhostMethod_ISchemaParticle_48_13; dispid 1610678284; + procedure GhostMethod_ISchemaParticle_52_14; dispid 1610678285; + property minOccurs: OleVariant readonly dispid 1455; + property maxOccurs: OleVariant readonly dispid 1451; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchema +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B4-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchema = interface(ISchemaItem) + ['{50EA08B4-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_targetNamespace: WideString; safecall; + function Get_version: WideString; safecall; + function Get_types: ISchemaItemCollection; safecall; + function Get_elements: ISchemaItemCollection; safecall; + function Get_attributes: ISchemaItemCollection; safecall; + function Get_attributeGroups: ISchemaItemCollection; safecall; + function Get_modelGroups: ISchemaItemCollection; safecall; + function Get_notations: ISchemaItemCollection; safecall; + function Get_schemaLocations: ISchemaStringCollection; safecall; + property targetNamespace: WideString read Get_targetNamespace; + property version: WideString read Get_version; + property types: ISchemaItemCollection read Get_types; + property elements: ISchemaItemCollection read Get_elements; + property attributes: ISchemaItemCollection read Get_attributes; + property attributeGroups: ISchemaItemCollection read Get_attributeGroups; + property modelGroups: ISchemaItemCollection read Get_modelGroups; + property notations: ISchemaItemCollection read Get_notations; + property schemaLocations: ISchemaStringCollection read Get_schemaLocations; + end; + +// *********************************************************************// +// DispIntf: ISchemaDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B4-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaDisp = dispinterface + ['{50EA08B4-DD1B-4664-9A50-C2F40F4BD79A}'] + property targetNamespace: WideString readonly dispid 1474; + property version: WideString readonly dispid 1481; + property types: ISchemaItemCollection readonly dispid 1477; + property elements: ISchemaItemCollection readonly dispid 1434; + property attributes: ISchemaItemCollection readonly dispid 1427; + property attributeGroups: ISchemaItemCollection readonly dispid 1426; + property modelGroups: ISchemaItemCollection readonly dispid 1456; + property notations: ISchemaItemCollection readonly dispid 1460; + property schemaLocations: ISchemaStringCollection readonly dispid 1468; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaItemCollection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B2-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaItemCollection = interface(IDispatch) + ['{50EA08B2-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_item(index: Integer): ISchemaItem; safecall; + function itemByName(const name: WideString): ISchemaItem; safecall; + function itemByQName(const name: WideString; const namespaceURI: WideString): ISchemaItem; safecall; + function Get_length: Integer; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: ISchemaItem read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: ISchemaItemCollectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B2-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaItemCollectionDisp = dispinterface + ['{50EA08B2-DD1B-4664-9A50-C2F40F4BD79A}'] + property item[index: Integer]: ISchemaItem readonly dispid 0; default; + function itemByName(const name: WideString): ISchemaItem; dispid 1423; + function itemByQName(const name: WideString; const namespaceURI: WideString): ISchemaItem; dispid 1424; + property length: Integer readonly dispid 1447; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: ISchemaStringCollection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B1-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaStringCollection = interface(IDispatch) + ['{50EA08B1-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_item(index: Integer): WideString; safecall; + function Get_length: Integer; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: WideString read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: ISchemaStringCollectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B1-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaStringCollectionDisp = dispinterface + ['{50EA08B1-DD1B-4664-9A50-C2F40F4BD79A}'] + property item[index: Integer]: WideString readonly dispid 0; default; + property length: Integer readonly dispid 1447; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: ISchemaType +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B8-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaType = interface(ISchemaItem) + ['{50EA08B8-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_baseTypes: ISchemaItemCollection; safecall; + function Get_final: SCHEMADERIVATIONMETHOD; safecall; + function Get_variety: SCHEMATYPEVARIETY; safecall; + function Get_derivedBy: SCHEMADERIVATIONMETHOD; safecall; + function isValid(const data: WideString): WordBool; safecall; + function Get_minExclusive: WideString; safecall; + function Get_minInclusive: WideString; safecall; + function Get_maxExclusive: WideString; safecall; + function Get_maxInclusive: WideString; safecall; + function Get_totalDigits: OleVariant; safecall; + function Get_fractionDigits: OleVariant; safecall; + function Get_length: OleVariant; safecall; + function Get_minLength: OleVariant; safecall; + function Get_maxLength: OleVariant; safecall; + function Get_enumeration: ISchemaStringCollection; safecall; + function Get_whitespace: SCHEMAWHITESPACE; safecall; + function Get_patterns: ISchemaStringCollection; safecall; + property baseTypes: ISchemaItemCollection read Get_baseTypes; + property final: SCHEMADERIVATIONMETHOD read Get_final; + property variety: SCHEMATYPEVARIETY read Get_variety; + property derivedBy: SCHEMADERIVATIONMETHOD read Get_derivedBy; + property minExclusive: WideString read Get_minExclusive; + property minInclusive: WideString read Get_minInclusive; + property maxExclusive: WideString read Get_maxExclusive; + property maxInclusive: WideString read Get_maxInclusive; + property totalDigits: OleVariant read Get_totalDigits; + property fractionDigits: OleVariant read Get_fractionDigits; + property length: OleVariant read Get_length; + property minLength: OleVariant read Get_minLength; + property maxLength: OleVariant read Get_maxLength; + property enumeration: ISchemaStringCollection read Get_enumeration; + property whitespace: SCHEMAWHITESPACE read Get_whitespace; + property patterns: ISchemaStringCollection read Get_patterns; + end; + +// *********************************************************************// +// DispIntf: ISchemaTypeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B8-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaTypeDisp = dispinterface + ['{50EA08B8-DD1B-4664-9A50-C2F40F4BD79A}'] + property baseTypes: ISchemaItemCollection readonly dispid 1428; + property final: SCHEMADERIVATIONMETHOD readonly dispid 1437; + property variety: SCHEMATYPEVARIETY readonly dispid 1480; + property derivedBy: SCHEMADERIVATIONMETHOD readonly dispid 1432; + function isValid(const data: WideString): WordBool; dispid 1445; + property minExclusive: WideString readonly dispid 1452; + property minInclusive: WideString readonly dispid 1453; + property maxExclusive: WideString readonly dispid 1448; + property maxInclusive: WideString readonly dispid 1449; + property totalDigits: OleVariant readonly dispid 1475; + property fractionDigits: OleVariant readonly dispid 1439; + property length: OleVariant readonly dispid 1447; + property minLength: OleVariant readonly dispid 1454; + property maxLength: OleVariant readonly dispid 1450; + property enumeration: ISchemaStringCollection readonly dispid 1435; + property whitespace: SCHEMAWHITESPACE readonly dispid 1482; + property patterns: ISchemaStringCollection readonly dispid 1462; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaComplexType +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B9-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaComplexType = interface(ISchemaType) + ['{50EA08B9-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_isAbstract: WordBool; safecall; + function Get_anyAttribute: ISchemaAny; safecall; + function Get_attributes: ISchemaItemCollection; safecall; + function Get_contentType: SCHEMACONTENTTYPE; safecall; + function Get_contentModel: ISchemaModelGroup; safecall; + function Get_prohibitedSubstitutions: SCHEMADERIVATIONMETHOD; safecall; + property isAbstract: WordBool read Get_isAbstract; + property anyAttribute: ISchemaAny read Get_anyAttribute; + property attributes: ISchemaItemCollection read Get_attributes; + property contentType: SCHEMACONTENTTYPE read Get_contentType; + property contentModel: ISchemaModelGroup read Get_contentModel; + property prohibitedSubstitutions: SCHEMADERIVATIONMETHOD read Get_prohibitedSubstitutions; + end; + +// *********************************************************************// +// DispIntf: ISchemaComplexTypeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B9-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaComplexTypeDisp = dispinterface + ['{50EA08B9-DD1B-4664-9A50-C2F40F4BD79A}'] + property isAbstract: WordBool readonly dispid 1442; + property anyAttribute: ISchemaAny readonly dispid 1425; + property attributes: ISchemaItemCollection readonly dispid 1427; + property contentType: SCHEMACONTENTTYPE readonly dispid 1430; + property contentModel: ISchemaModelGroup readonly dispid 1429; + property prohibitedSubstitutions: SCHEMADERIVATIONMETHOD readonly dispid 1464; + property baseTypes: ISchemaItemCollection readonly dispid 1428; + property final: SCHEMADERIVATIONMETHOD readonly dispid 1437; + property variety: SCHEMATYPEVARIETY readonly dispid 1480; + property derivedBy: SCHEMADERIVATIONMETHOD readonly dispid 1432; + function isValid(const data: WideString): WordBool; dispid 1445; + property minExclusive: WideString readonly dispid 1452; + property minInclusive: WideString readonly dispid 1453; + property maxExclusive: WideString readonly dispid 1448; + property maxInclusive: WideString readonly dispid 1449; + property totalDigits: OleVariant readonly dispid 1475; + property fractionDigits: OleVariant readonly dispid 1439; + property length: OleVariant readonly dispid 1447; + property minLength: OleVariant readonly dispid 1454; + property maxLength: OleVariant readonly dispid 1450; + property enumeration: ISchemaStringCollection readonly dispid 1435; + property whitespace: SCHEMAWHITESPACE readonly dispid 1482; + property patterns: ISchemaStringCollection readonly dispid 1462; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaAny +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BC-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaAny = interface(ISchemaParticle) + ['{50EA08BC-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_namespaces: ISchemaStringCollection; safecall; + function Get_processContents: SCHEMAPROCESSCONTENTS; safecall; + property namespaces: ISchemaStringCollection read Get_namespaces; + property processContents: SCHEMAPROCESSCONTENTS read Get_processContents; + end; + +// *********************************************************************// +// DispIntf: ISchemaAnyDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BC-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaAnyDisp = dispinterface + ['{50EA08BC-DD1B-4664-9A50-C2F40F4BD79A}'] + property namespaces: ISchemaStringCollection readonly dispid 1458; + property processContents: SCHEMAPROCESSCONTENTS readonly dispid 1463; + procedure GhostMethod_ISchemaParticle_0_1; dispid 1610678272; + procedure GhostMethod_ISchemaParticle_4_2; dispid 1610678273; + procedure GhostMethod_ISchemaParticle_8_3; dispid 1610678274; + procedure GhostMethod_ISchemaParticle_12_4; dispid 1610678275; + procedure GhostMethod_ISchemaParticle_16_5; dispid 1610678276; + procedure GhostMethod_ISchemaParticle_20_6; dispid 1610678277; + procedure GhostMethod_ISchemaParticle_24_7; dispid 1610678278; + procedure GhostMethod_ISchemaParticle_28_8; dispid 1610678279; + procedure GhostMethod_ISchemaParticle_32_9; dispid 1610678280; + procedure GhostMethod_ISchemaParticle_36_10; dispid 1610678281; + procedure GhostMethod_ISchemaParticle_40_11; dispid 1610678282; + procedure GhostMethod_ISchemaParticle_44_12; dispid 1610678283; + procedure GhostMethod_ISchemaParticle_48_13; dispid 1610678284; + procedure GhostMethod_ISchemaParticle_52_14; dispid 1610678285; + property minOccurs: OleVariant readonly dispid 1455; + property maxOccurs: OleVariant readonly dispid 1451; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaModelGroup +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BB-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaModelGroup = interface(ISchemaParticle) + ['{50EA08BB-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_particles: ISchemaItemCollection; safecall; + property particles: ISchemaItemCollection read Get_particles; + end; + +// *********************************************************************// +// DispIntf: ISchemaModelGroupDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BB-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaModelGroupDisp = dispinterface + ['{50EA08BB-DD1B-4664-9A50-C2F40F4BD79A}'] + property particles: ISchemaItemCollection readonly dispid 1461; + procedure GhostMethod_ISchemaParticle_0_1; dispid 1610678272; + procedure GhostMethod_ISchemaParticle_4_2; dispid 1610678273; + procedure GhostMethod_ISchemaParticle_8_3; dispid 1610678274; + procedure GhostMethod_ISchemaParticle_12_4; dispid 1610678275; + procedure GhostMethod_ISchemaParticle_16_5; dispid 1610678276; + procedure GhostMethod_ISchemaParticle_20_6; dispid 1610678277; + procedure GhostMethod_ISchemaParticle_24_7; dispid 1610678278; + procedure GhostMethod_ISchemaParticle_28_8; dispid 1610678279; + procedure GhostMethod_ISchemaParticle_32_9; dispid 1610678280; + procedure GhostMethod_ISchemaParticle_36_10; dispid 1610678281; + procedure GhostMethod_ISchemaParticle_40_11; dispid 1610678282; + procedure GhostMethod_ISchemaParticle_44_12; dispid 1610678283; + procedure GhostMethod_ISchemaParticle_48_13; dispid 1610678284; + procedure GhostMethod_ISchemaParticle_52_14; dispid 1610678285; + property minOccurs: OleVariant readonly dispid 1455; + property maxOccurs: OleVariant readonly dispid 1451; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: IMXXMLFilter +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {C90352F7-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IMXXMLFilter = interface(IDispatch) + ['{C90352F7-643C-4FBC-BB23-E996EB2D51FD}'] + function getFeature(const strName: WideString): WordBool; safecall; + procedure putFeature(const strName: WideString; fValue: WordBool); safecall; + function getProperty(const strName: WideString): OleVariant; safecall; + procedure putProperty(const strName: WideString; varValue: OleVariant); safecall; + function Get_entityResolver: IUnknown; safecall; + procedure _Set_entityResolver(const oResolver: IUnknown); safecall; + function Get_contentHandler: IUnknown; safecall; + procedure _Set_contentHandler(const oHandler: IUnknown); safecall; + function Get_dtdHandler: IUnknown; safecall; + procedure _Set_dtdHandler(const oHandler: IUnknown); safecall; + function Get_errorHandler: IUnknown; safecall; + procedure _Set_errorHandler(const oHandler: IUnknown); safecall; + property entityResolver: IUnknown read Get_entityResolver write _Set_entityResolver; + property contentHandler: IUnknown read Get_contentHandler write _Set_contentHandler; + property dtdHandler: IUnknown read Get_dtdHandler write _Set_dtdHandler; + property errorHandler: IUnknown read Get_errorHandler write _Set_errorHandler; + end; + +// *********************************************************************// +// DispIntf: IMXXMLFilterDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {C90352F7-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IMXXMLFilterDisp = dispinterface + ['{C90352F7-643C-4FBC-BB23-E996EB2D51FD}'] + function getFeature(const strName: WideString): WordBool; dispid 1423; + procedure putFeature(const strName: WideString; fValue: WordBool); dispid 1425; + function getProperty(const strName: WideString): OleVariant; dispid 1424; + procedure putProperty(const strName: WideString; varValue: OleVariant); dispid 1426; + property entityResolver: IUnknown dispid 1421; + property contentHandler: IUnknown dispid 1419; + property dtdHandler: IUnknown dispid 1420; + property errorHandler: IUnknown dispid 1422; + end; + +// *********************************************************************// +// Interface: IXMLDOMSchemaCollection2 +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B0-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + IXMLDOMSchemaCollection2 = interface(IXMLDOMSchemaCollection) + ['{50EA08B0-DD1B-4664-9A50-C2F40F4BD79A}'] + procedure validate; safecall; + procedure Set_validateOnLoad(validateOnLoad: WordBool); safecall; + function Get_validateOnLoad: WordBool; safecall; + function getSchema(const namespaceURI: WideString): ISchema; safecall; + function getDeclaration(const node: IXMLDOMNode): ISchemaItem; safecall; + property validateOnLoad: WordBool read Get_validateOnLoad write Set_validateOnLoad; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMSchemaCollection2Disp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B0-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + IXMLDOMSchemaCollection2Disp = dispinterface + ['{50EA08B0-DD1B-4664-9A50-C2F40F4BD79A}'] + procedure validate; dispid 1419; + property validateOnLoad: WordBool dispid 1420; + function getSchema(const namespaceURI: WideString): ISchema; dispid 1421; + function getDeclaration(const node: IXMLDOMNode): ISchemaItem; dispid 1422; + procedure add(const namespaceURI: WideString; var_: OleVariant); dispid 3; + function get(const namespaceURI: WideString): IXMLDOMNode; dispid 4; + procedure remove(const namespaceURI: WideString); dispid 5; + property length: Integer readonly dispid 6; + property namespaceURI[index: Integer]: WideString readonly dispid 0; default; + procedure addCollection(const otherCollection: IXMLDOMSchemaCollection); dispid 8; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: ISchemaAttribute +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B6-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaAttribute = interface(ISchemaItem) + ['{50EA08B6-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_type_: ISchemaType; safecall; + function Get_scope: ISchemaComplexType; safecall; + function Get_defaultValue: WideString; safecall; + function Get_fixedValue: WideString; safecall; + function Get_use: SCHEMAUSE; safecall; + function Get_isReference: WordBool; safecall; + property type_: ISchemaType read Get_type_; + property scope: ISchemaComplexType read Get_scope; + property defaultValue: WideString read Get_defaultValue; + property fixedValue: WideString read Get_fixedValue; + property use: SCHEMAUSE read Get_use; + property isReference: WordBool read Get_isReference; + end; + +// *********************************************************************// +// DispIntf: ISchemaAttributeDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08B6-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaAttributeDisp = dispinterface + ['{50EA08B6-DD1B-4664-9A50-C2F40F4BD79A}'] + property type_: ISchemaType readonly dispid 1476; + property scope: ISchemaComplexType readonly dispid 1469; + property defaultValue: WideString readonly dispid 1431; + property fixedValue: WideString readonly dispid 1438; + property use: SCHEMAUSE readonly dispid 1479; + property isReference: WordBool readonly dispid 1444; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaAttributeGroup +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BA-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaAttributeGroup = interface(ISchemaItem) + ['{50EA08BA-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_anyAttribute: ISchemaAny; safecall; + function Get_attributes: ISchemaItemCollection; safecall; + property anyAttribute: ISchemaAny read Get_anyAttribute; + property attributes: ISchemaItemCollection read Get_attributes; + end; + +// *********************************************************************// +// DispIntf: ISchemaAttributeGroupDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BA-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaAttributeGroupDisp = dispinterface + ['{50EA08BA-DD1B-4664-9A50-C2F40F4BD79A}'] + property anyAttribute: ISchemaAny readonly dispid 1425; + property attributes: ISchemaItemCollection readonly dispid 1427; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaIdentityConstraint +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BD-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaIdentityConstraint = interface(ISchemaItem) + ['{50EA08BD-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_selector: WideString; safecall; + function Get_fields: ISchemaStringCollection; safecall; + function Get_referencedKey: ISchemaIdentityConstraint; safecall; + property selector: WideString read Get_selector; + property fields: ISchemaStringCollection read Get_fields; + property referencedKey: ISchemaIdentityConstraint read Get_referencedKey; + end; + +// *********************************************************************// +// DispIntf: ISchemaIdentityConstraintDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BD-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaIdentityConstraintDisp = dispinterface + ['{50EA08BD-DD1B-4664-9A50-C2F40F4BD79A}'] + property selector: WideString readonly dispid 1470; + property fields: ISchemaStringCollection readonly dispid 1436; + property referencedKey: ISchemaIdentityConstraint readonly dispid 1466; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: ISchemaNotation +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BE-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaNotation = interface(ISchemaItem) + ['{50EA08BE-DD1B-4664-9A50-C2F40F4BD79A}'] + function Get_systemIdentifier: WideString; safecall; + function Get_publicIdentifier: WideString; safecall; + property systemIdentifier: WideString read Get_systemIdentifier; + property publicIdentifier: WideString read Get_publicIdentifier; + end; + +// *********************************************************************// +// DispIntf: ISchemaNotationDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {50EA08BE-DD1B-4664-9A50-C2F40F4BD79A} +// *********************************************************************// + ISchemaNotationDisp = dispinterface + ['{50EA08BE-DD1B-4664-9A50-C2F40F4BD79A}'] + property systemIdentifier: WideString readonly dispid 1473; + property publicIdentifier: WideString readonly dispid 1465; + property name: WideString readonly dispid 1457; + property namespaceURI: WideString readonly dispid 1459; + property schema: ISchema readonly dispid 1467; + property id: WideString readonly dispid 1440; + property itemType: SOMITEMTYPE readonly dispid 1446; + property unhandledAttributes: IVBSAXAttributes readonly dispid 1478; + function writeAnnotation(const annotationSink: IUnknown): WordBool; dispid 1483; + end; + +// *********************************************************************// +// Interface: IXMLDOMSelection +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {AA634FC7-5888-44A7-A257-3A47150D3A0E} +// *********************************************************************// + IXMLDOMSelection = interface(IXMLDOMNodeList) + ['{AA634FC7-5888-44A7-A257-3A47150D3A0E}'] + function Get_expr: WideString; safecall; + procedure Set_expr(const expression: WideString); safecall; + function Get_context: IXMLDOMNode; safecall; + procedure _Set_context(const ppNode: IXMLDOMNode); safecall; + function peekNode: IXMLDOMNode; safecall; + function matches(const pNode: IXMLDOMNode): IXMLDOMNode; safecall; + function removeNext: IXMLDOMNode; safecall; + procedure removeAll; safecall; + function clone: IXMLDOMSelection; safecall; + function getProperty(const name: WideString): OleVariant; safecall; + procedure setProperty(const name: WideString; value: OleVariant); safecall; + property expr: WideString read Get_expr write Set_expr; + property context: IXMLDOMNode read Get_context write _Set_context; + end; + +// *********************************************************************// +// DispIntf: IXMLDOMSelectionDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {AA634FC7-5888-44A7-A257-3A47150D3A0E} +// *********************************************************************// + IXMLDOMSelectionDisp = dispinterface + ['{AA634FC7-5888-44A7-A257-3A47150D3A0E}'] + property expr: WideString dispid 81; + property context: IXMLDOMNode dispid 82; + function peekNode: IXMLDOMNode; dispid 83; + function matches(const pNode: IXMLDOMNode): IXMLDOMNode; dispid 84; + function removeNext: IXMLDOMNode; dispid 85; + procedure removeAll; dispid 86; + function clone: IXMLDOMSelection; dispid 87; + function getProperty(const name: WideString): OleVariant; dispid 88; + procedure setProperty(const name: WideString; value: OleVariant); dispid 89; + property item[index: Integer]: IXMLDOMNode readonly dispid 0; default; + property length: Integer readonly dispid 74; + function nextNode: IXMLDOMNode; dispid 76; + procedure reset; dispid 77; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// DispIntf: XMLDOMDocumentEvents +// Flags: (4112) Hidden Dispatchable +// GUID: {3EFAA427-272F-11D2-836F-0000F87A7782} +// *********************************************************************// + XMLDOMDocumentEvents = dispinterface + ['{3EFAA427-272F-11D2-836F-0000F87A7782}'] + procedure ondataavailable; dispid 198; + procedure onreadystatechange; dispid -609; + end; + +// *********************************************************************// +// Interface: IDSOControl +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {310AFA62-0575-11D2-9CA9-0060B0EC3D39} +// *********************************************************************// + IDSOControl = interface(IDispatch) + ['{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'] + function Get_XMLDocument: IXMLDOMDocument; safecall; + procedure Set_XMLDocument(const ppDoc: IXMLDOMDocument); safecall; + function Get_JavaDSOCompatible: Integer; safecall; + procedure Set_JavaDSOCompatible(fJavaDSOCompatible: Integer); safecall; + function Get_readyState: Integer; safecall; + property XMLDocument: IXMLDOMDocument read Get_XMLDocument write Set_XMLDocument; + property JavaDSOCompatible: Integer read Get_JavaDSOCompatible write Set_JavaDSOCompatible; + property readyState: Integer read Get_readyState; + end; + +// *********************************************************************// +// DispIntf: IDSOControlDisp +// Flags: (4560) Hidden Dual NonExtensible OleAutomation Dispatchable +// GUID: {310AFA62-0575-11D2-9CA9-0060B0EC3D39} +// *********************************************************************// + IDSOControlDisp = dispinterface + ['{310AFA62-0575-11D2-9CA9-0060B0EC3D39}'] + property XMLDocument: IXMLDOMDocument dispid 65537; + property JavaDSOCompatible: Integer dispid 65538; + property readyState: Integer readonly dispid -525; + end; + +// *********************************************************************// +// Interface: IXMLHTTPRequest +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {ED8C108D-4349-11D2-91A4-00C04F7969E8} +// *********************************************************************// + IXMLHTTPRequest = interface(IDispatch) + ['{ED8C108D-4349-11D2-91A4-00C04F7969E8}'] + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); safecall; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); safecall; + function getResponseHeader(const bstrHeader: WideString): WideString; safecall; + function getAllResponseHeaders: WideString; safecall; + procedure send(varBody: OleVariant); safecall; + procedure abort; safecall; + function Get_status: Integer; safecall; + function Get_statusText: WideString; safecall; + function Get_responseXML: IDispatch; safecall; + function Get_responseText: WideString; safecall; + function Get_responseBody: OleVariant; safecall; + function Get_responseStream: OleVariant; safecall; + function Get_readyState: Integer; safecall; + procedure Set_onreadystatechange(const Param1: IDispatch); safecall; + property status: Integer read Get_status; + property statusText: WideString read Get_statusText; + property responseXML: IDispatch read Get_responseXML; + property responseText: WideString read Get_responseText; + property responseBody: OleVariant read Get_responseBody; + property responseStream: OleVariant read Get_responseStream; + property readyState: Integer read Get_readyState; + property onreadystatechange: IDispatch write Set_onreadystatechange; + end; + +// *********************************************************************// +// DispIntf: IXMLHTTPRequestDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {ED8C108D-4349-11D2-91A4-00C04F7969E8} +// *********************************************************************// + IXMLHTTPRequestDisp = dispinterface + ['{ED8C108D-4349-11D2-91A4-00C04F7969E8}'] + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); dispid 1; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); dispid 2; + function getResponseHeader(const bstrHeader: WideString): WideString; dispid 3; + function getAllResponseHeaders: WideString; dispid 4; + procedure send(varBody: OleVariant); dispid 5; + procedure abort; dispid 6; + property status: Integer readonly dispid 7; + property statusText: WideString readonly dispid 8; + property responseXML: IDispatch readonly dispid 9; + property responseText: WideString readonly dispid 10; + property responseBody: OleVariant readonly dispid 11; + property responseStream: OleVariant readonly dispid 12; + property readyState: Integer readonly dispid 13; + property onreadystatechange: IDispatch writeonly dispid 14; + end; + +// *********************************************************************// +// Interface: IServerXMLHTTPRequest +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2E9196BF-13BA-4DD4-91CA-6C571F281495} +// *********************************************************************// + IServerXMLHTTPRequest = interface(IXMLHTTPRequest) + ['{2E9196BF-13BA-4DD4-91CA-6C571F281495}'] + procedure setTimeouts(resolveTimeout: Integer; connectTimeout: Integer; sendTimeout: Integer; + receiveTimeout: Integer); safecall; + function waitForResponse(timeoutInSeconds: OleVariant): WordBool; safecall; + function getOption(option: SERVERXMLHTTP_OPTION): OleVariant; safecall; + procedure setOption(option: SERVERXMLHTTP_OPTION; value: OleVariant); safecall; + end; + +// *********************************************************************// +// DispIntf: IServerXMLHTTPRequestDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2E9196BF-13BA-4DD4-91CA-6C571F281495} +// *********************************************************************// + IServerXMLHTTPRequestDisp = dispinterface + ['{2E9196BF-13BA-4DD4-91CA-6C571F281495}'] + procedure setTimeouts(resolveTimeout: Integer; connectTimeout: Integer; sendTimeout: Integer; + receiveTimeout: Integer); dispid 15; + function waitForResponse(timeoutInSeconds: OleVariant): WordBool; dispid 16; + function getOption(option: SERVERXMLHTTP_OPTION): OleVariant; dispid 17; + procedure setOption(option: SERVERXMLHTTP_OPTION; value: OleVariant); dispid 18; + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); dispid 1; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); dispid 2; + function getResponseHeader(const bstrHeader: WideString): WideString; dispid 3; + function getAllResponseHeaders: WideString; dispid 4; + procedure send(varBody: OleVariant); dispid 5; + procedure abort; dispid 6; + property status: Integer readonly dispid 7; + property statusText: WideString readonly dispid 8; + property responseXML: IDispatch readonly dispid 9; + property responseText: WideString readonly dispid 10; + property responseBody: OleVariant readonly dispid 11; + property responseStream: OleVariant readonly dispid 12; + property readyState: Integer readonly dispid 13; + property onreadystatechange: IDispatch writeonly dispid 14; + end; + +// *********************************************************************// +// Interface: IServerXMLHTTPRequest2 +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2E01311B-C322-4B0A-BD77-B90CFDC8DCE7} +// *********************************************************************// + IServerXMLHTTPRequest2 = interface(IServerXMLHTTPRequest) + ['{2E01311B-C322-4B0A-BD77-B90CFDC8DCE7}'] + procedure setProxy(proxySetting: SXH_PROXY_SETTING; varProxyServer: OleVariant; + varBypassList: OleVariant); safecall; + procedure setProxyCredentials(const bstrUserName: WideString; const bstrPassword: WideString); safecall; + end; + +// *********************************************************************// +// DispIntf: IServerXMLHTTPRequest2Disp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {2E01311B-C322-4B0A-BD77-B90CFDC8DCE7} +// *********************************************************************// + IServerXMLHTTPRequest2Disp = dispinterface + ['{2E01311B-C322-4B0A-BD77-B90CFDC8DCE7}'] + procedure setProxy(proxySetting: SXH_PROXY_SETTING; varProxyServer: OleVariant; + varBypassList: OleVariant); dispid 19; + procedure setProxyCredentials(const bstrUserName: WideString; const bstrPassword: WideString); dispid 20; + procedure setTimeouts(resolveTimeout: Integer; connectTimeout: Integer; sendTimeout: Integer; + receiveTimeout: Integer); dispid 15; + function waitForResponse(timeoutInSeconds: OleVariant): WordBool; dispid 16; + function getOption(option: SERVERXMLHTTP_OPTION): OleVariant; dispid 17; + procedure setOption(option: SERVERXMLHTTP_OPTION; value: OleVariant); dispid 18; + procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant; + bstrUser: OleVariant; bstrPassword: OleVariant); dispid 1; + procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); dispid 2; + function getResponseHeader(const bstrHeader: WideString): WideString; dispid 3; + function getAllResponseHeaders: WideString; dispid 4; + procedure send(varBody: OleVariant); dispid 5; + procedure abort; dispid 6; + property status: Integer readonly dispid 7; + property statusText: WideString readonly dispid 8; + property responseXML: IDispatch readonly dispid 9; + property responseText: WideString readonly dispid 10; + property responseBody: OleVariant readonly dispid 11; + property responseStream: OleVariant readonly dispid 12; + property readyState: Integer readonly dispid 13; + property onreadystatechange: IDispatch writeonly dispid 14; + end; + +// *********************************************************************// +// Interface: IMXNamespacePrefixes +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {C90352F4-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IMXNamespacePrefixes = interface(IDispatch) + ['{C90352F4-643C-4FBC-BB23-E996EB2D51FD}'] + function Get_item(index: Integer): WideString; safecall; + function Get_length: Integer; safecall; + function Get__newEnum: IUnknown; safecall; + property item[index: Integer]: WideString read Get_item; default; + property length: Integer read Get_length; + property _newEnum: IUnknown read Get__newEnum; + end; + +// *********************************************************************// +// DispIntf: IMXNamespacePrefixesDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {C90352F4-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IMXNamespacePrefixesDisp = dispinterface + ['{C90352F4-643C-4FBC-BB23-E996EB2D51FD}'] + property item[index: Integer]: WideString readonly dispid 0; default; + property length: Integer readonly dispid 1416; + property _newEnum: IUnknown readonly dispid -4; + end; + +// *********************************************************************// +// Interface: IVBMXNamespaceManager +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {C90352F5-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IVBMXNamespaceManager = interface(IDispatch) + ['{C90352F5-643C-4FBC-BB23-E996EB2D51FD}'] + procedure Set_allowOverride(fOverride: WordBool); safecall; + function Get_allowOverride: WordBool; safecall; + procedure reset; safecall; + procedure pushContext; safecall; + procedure pushNodeContext(const contextNode: IXMLDOMNode; fDeep: WordBool); safecall; + procedure popContext; safecall; + procedure declarePrefix(const prefix: WideString; const namespaceURI: WideString); safecall; + function getDeclaredPrefixes: IMXNamespacePrefixes; safecall; + function getPrefixes(const namespaceURI: WideString): IMXNamespacePrefixes; safecall; + function getURI(const prefix: WideString): OleVariant; safecall; + function getURIFromNode(const strPrefix: WideString; const contextNode: IXMLDOMNode): OleVariant; safecall; + property allowOverride: WordBool read Get_allowOverride write Set_allowOverride; + end; + +// *********************************************************************// +// DispIntf: IVBMXNamespaceManagerDisp +// Flags: (4544) Dual NonExtensible OleAutomation Dispatchable +// GUID: {C90352F5-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IVBMXNamespaceManagerDisp = dispinterface + ['{C90352F5-643C-4FBC-BB23-E996EB2D51FD}'] + property allowOverride: WordBool dispid 1406; + procedure reset; dispid 1407; + procedure pushContext; dispid 1408; + procedure pushNodeContext(const contextNode: IXMLDOMNode; fDeep: WordBool); dispid 1409; + procedure popContext; dispid 1410; + procedure declarePrefix(const prefix: WideString; const namespaceURI: WideString); dispid 1411; + function getDeclaredPrefixes: IMXNamespacePrefixes; dispid 1412; + function getPrefixes(const namespaceURI: WideString): IMXNamespacePrefixes; dispid 1413; + function getURI(const prefix: WideString): OleVariant; dispid 1414; + function getURIFromNode(const strPrefix: WideString; const contextNode: IXMLDOMNode): OleVariant; dispid 1415; + end; + +// *********************************************************************// +// Interface: IMXNamespaceManager +// Flags: (16) Hidden +// GUID: {C90352F6-643C-4FBC-BB23-E996EB2D51FD} +// *********************************************************************// + IMXNamespaceManager = interface(IUnknown) + ['{C90352F6-643C-4FBC-BB23-E996EB2D51FD}'] + function putAllowOverride(fOverride: WordBool): HResult; stdcall; + function getAllowOverride(out fOverride: WordBool): HResult; stdcall; + function reset: HResult; stdcall; + function pushContext: HResult; stdcall; + function pushNodeContext(const contextNode: IXMLDOMNode; fDeep: WordBool): HResult; stdcall; + function popContext: HResult; stdcall; + function declarePrefix(var prefix: Word; var namespaceURI: Word): HResult; stdcall; + function getDeclaredPrefix(nIndex: Integer; var pwchPrefix: Word; var pcchPrefix: SYSINT): HResult; stdcall; + function getPrefix(var pwszNamespaceURI: Word; nIndex: Integer; var pwchPrefix: Word; + var pcchPrefix: SYSINT): HResult; stdcall; + function getURI(var pwchPrefix: Word; const pContextNode: IXMLDOMNode; var pwchUri: Word; + var pcchUri: SYSINT): HResult; stdcall; + end; + +// *********************************************************************// +// The Class CoDOMDocument provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass DOMDocument. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDOMDocument = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoDOMDocument26 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass DOMDocument26. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDOMDocument26 = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoDOMDocument30 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass DOMDocument30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDOMDocument30 = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoDOMDocument40 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass DOMDocument40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDOMDocument40 = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoDOMDocument60 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument3 exposed by +// the CoClass DOMDocument60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDOMDocument60 = class + class function Create: IXMLDOMDocument3; + class function CreateRemote(const MachineName: string): IXMLDOMDocument3; + end; + +// *********************************************************************// +// The Class CoFreeThreadedDOMDocument provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass FreeThreadedDOMDocument. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFreeThreadedDOMDocument = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoFreeThreadedDOMDocument26 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass FreeThreadedDOMDocument26. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFreeThreadedDOMDocument26 = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoFreeThreadedDOMDocument30 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass FreeThreadedDOMDocument30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFreeThreadedDOMDocument30 = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoFreeThreadedDOMDocument40 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument2 exposed by +// the CoClass FreeThreadedDOMDocument40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFreeThreadedDOMDocument40 = class + class function Create: IXMLDOMDocument2; + class function CreateRemote(const MachineName: string): IXMLDOMDocument2; + end; + +// *********************************************************************// +// The Class CoFreeThreadedDOMDocument60 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMDocument3 exposed by +// the CoClass FreeThreadedDOMDocument60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoFreeThreadedDOMDocument60 = class + class function Create: IXMLDOMDocument3; + class function CreateRemote(const MachineName: string): IXMLDOMDocument3; + end; + +// *********************************************************************// +// The Class CoXMLSchemaCache provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMSchemaCollection exposed by +// the CoClass XMLSchemaCache. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLSchemaCache = class + class function Create: IXMLDOMSchemaCollection; + class function CreateRemote(const MachineName: string): IXMLDOMSchemaCollection; + end; + +// *********************************************************************// +// The Class CoXMLSchemaCache26 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMSchemaCollection exposed by +// the CoClass XMLSchemaCache26. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLSchemaCache26 = class + class function Create: IXMLDOMSchemaCollection; + class function CreateRemote(const MachineName: string): IXMLDOMSchemaCollection; + end; + +// *********************************************************************// +// The Class CoXMLSchemaCache30 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMSchemaCollection exposed by +// the CoClass XMLSchemaCache30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLSchemaCache30 = class + class function Create: IXMLDOMSchemaCollection; + class function CreateRemote(const MachineName: string): IXMLDOMSchemaCollection; + end; + +// *********************************************************************// +// The Class CoXMLSchemaCache40 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMSchemaCollection2 exposed by +// the CoClass XMLSchemaCache40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLSchemaCache40 = class + class function Create: IXMLDOMSchemaCollection2; + class function CreateRemote(const MachineName: string): IXMLDOMSchemaCollection2; + end; + +// *********************************************************************// +// The Class CoXMLSchemaCache60 provides a Create and CreateRemote method to +// create instances of the default interface IXMLDOMSchemaCollection2 exposed by +// the CoClass XMLSchemaCache60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLSchemaCache60 = class + class function Create: IXMLDOMSchemaCollection2; + class function CreateRemote(const MachineName: string): IXMLDOMSchemaCollection2; + end; + +// *********************************************************************// +// The Class CoXSLTemplate provides a Create and CreateRemote method to +// create instances of the default interface IXSLTemplate exposed by +// the CoClass XSLTemplate. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXSLTemplate = class + class function Create: IXSLTemplate; + class function CreateRemote(const MachineName: string): IXSLTemplate; + end; + +// *********************************************************************// +// The Class CoXSLTemplate26 provides a Create and CreateRemote method to +// create instances of the default interface IXSLTemplate exposed by +// the CoClass XSLTemplate26. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXSLTemplate26 = class + class function Create: IXSLTemplate; + class function CreateRemote(const MachineName: string): IXSLTemplate; + end; + +// *********************************************************************// +// The Class CoXSLTemplate30 provides a Create and CreateRemote method to +// create instances of the default interface IXSLTemplate exposed by +// the CoClass XSLTemplate30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXSLTemplate30 = class + class function Create: IXSLTemplate; + class function CreateRemote(const MachineName: string): IXSLTemplate; + end; + +// *********************************************************************// +// The Class CoXSLTemplate40 provides a Create and CreateRemote method to +// create instances of the default interface IXSLTemplate exposed by +// the CoClass XSLTemplate40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXSLTemplate40 = class + class function Create: IXSLTemplate; + class function CreateRemote(const MachineName: string): IXSLTemplate; + end; + +// *********************************************************************// +// The Class CoXSLTemplate60 provides a Create and CreateRemote method to +// create instances of the default interface IXSLTemplate exposed by +// the CoClass XSLTemplate60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXSLTemplate60 = class + class function Create: IXSLTemplate; + class function CreateRemote(const MachineName: string): IXSLTemplate; + end; + +// *********************************************************************// +// The Class CoDSOControl provides a Create and CreateRemote method to +// create instances of the default interface IDSOControl exposed by +// the CoClass DSOControl. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSOControl = class + class function Create: IDSOControl; + class function CreateRemote(const MachineName: string): IDSOControl; + end; + +// *********************************************************************// +// The Class CoDSOControl26 provides a Create and CreateRemote method to +// create instances of the default interface IDSOControl exposed by +// the CoClass DSOControl26. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSOControl26 = class + class function Create: IDSOControl; + class function CreateRemote(const MachineName: string): IDSOControl; + end; + +// *********************************************************************// +// The Class CoDSOControl30 provides a Create and CreateRemote method to +// create instances of the default interface IDSOControl exposed by +// the CoClass DSOControl30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSOControl30 = class + class function Create: IDSOControl; + class function CreateRemote(const MachineName: string): IDSOControl; + end; + +// *********************************************************************// +// The Class CoDSOControl40 provides a Create and CreateRemote method to +// create instances of the default interface IDSOControl exposed by +// the CoClass DSOControl40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoDSOControl40 = class + class function Create: IDSOControl; + class function CreateRemote(const MachineName: string): IDSOControl; + end; + +// *********************************************************************// +// The Class CoXMLHTTP provides a Create and CreateRemote method to +// create instances of the default interface IXMLHTTPRequest exposed by +// the CoClass XMLHTTP. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLHTTP = class + class function Create: IXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoXMLHTTP26 provides a Create and CreateRemote method to +// create instances of the default interface IXMLHTTPRequest exposed by +// the CoClass XMLHTTP26. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLHTTP26 = class + class function Create: IXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoXMLHTTP30 provides a Create and CreateRemote method to +// create instances of the default interface IXMLHTTPRequest exposed by +// the CoClass XMLHTTP30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLHTTP30 = class + class function Create: IXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoXMLHTTP40 provides a Create and CreateRemote method to +// create instances of the default interface IXMLHTTPRequest exposed by +// the CoClass XMLHTTP40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLHTTP40 = class + class function Create: IXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoXMLHTTP60 provides a Create and CreateRemote method to +// create instances of the default interface IXMLHTTPRequest exposed by +// the CoClass XMLHTTP60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoXMLHTTP60 = class + class function Create: IXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoServerXMLHTTP provides a Create and CreateRemote method to +// create instances of the default interface IServerXMLHTTPRequest exposed by +// the CoClass ServerXMLHTTP. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerXMLHTTP = class + class function Create: IServerXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IServerXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoServerXMLHTTP30 provides a Create and CreateRemote method to +// create instances of the default interface IServerXMLHTTPRequest exposed by +// the CoClass ServerXMLHTTP30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerXMLHTTP30 = class + class function Create: IServerXMLHTTPRequest; + class function CreateRemote(const MachineName: string): IServerXMLHTTPRequest; + end; + +// *********************************************************************// +// The Class CoServerXMLHTTP40 provides a Create and CreateRemote method to +// create instances of the default interface IServerXMLHTTPRequest2 exposed by +// the CoClass ServerXMLHTTP40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerXMLHTTP40 = class + class function Create: IServerXMLHTTPRequest2; + class function CreateRemote(const MachineName: string): IServerXMLHTTPRequest2; + end; + +// *********************************************************************// +// The Class CoServerXMLHTTP60 provides a Create and CreateRemote method to +// create instances of the default interface IServerXMLHTTPRequest2 exposed by +// the CoClass ServerXMLHTTP60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoServerXMLHTTP60 = class + class function Create: IServerXMLHTTPRequest2; + class function CreateRemote(const MachineName: string): IServerXMLHTTPRequest2; + end; + +// *********************************************************************// +// The Class CoSAXXMLReader provides a Create and CreateRemote method to +// create instances of the default interface IVBSAXXMLReader exposed by +// the CoClass SAXXMLReader. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXXMLReader = class + class function Create: IVBSAXXMLReader; + class function CreateRemote(const MachineName: string): IVBSAXXMLReader; + end; + +// *********************************************************************// +// The Class CoSAXXMLReader30 provides a Create and CreateRemote method to +// create instances of the default interface IVBSAXXMLReader exposed by +// the CoClass SAXXMLReader30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXXMLReader30 = class + class function Create: IVBSAXXMLReader; + class function CreateRemote(const MachineName: string): IVBSAXXMLReader; + end; + +// *********************************************************************// +// The Class CoSAXXMLReader40 provides a Create and CreateRemote method to +// create instances of the default interface IVBSAXXMLReader exposed by +// the CoClass SAXXMLReader40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXXMLReader40 = class + class function Create: IVBSAXXMLReader; + class function CreateRemote(const MachineName: string): IVBSAXXMLReader; + end; + +// *********************************************************************// +// The Class CoSAXXMLReader60 provides a Create and CreateRemote method to +// create instances of the default interface IVBSAXXMLReader exposed by +// the CoClass SAXXMLReader60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXXMLReader60 = class + class function Create: IVBSAXXMLReader; + class function CreateRemote(const MachineName: string): IVBSAXXMLReader; + end; + +// *********************************************************************// +// The Class CoMXXMLWriter provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXXMLWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXXMLWriter = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXXMLWriter30 provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXXMLWriter30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXXMLWriter30 = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXXMLWriter40 provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXXMLWriter40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXXMLWriter40 = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXXMLWriter60 provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXXMLWriter60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXXMLWriter60 = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXHTMLWriter provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXHTMLWriter. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXHTMLWriter = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXHTMLWriter30 provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXHTMLWriter30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXHTMLWriter30 = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXHTMLWriter40 provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXHTMLWriter40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXHTMLWriter40 = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoMXHTMLWriter60 provides a Create and CreateRemote method to +// create instances of the default interface IMXWriter exposed by +// the CoClass MXHTMLWriter60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXHTMLWriter60 = class + class function Create: IMXWriter; + class function CreateRemote(const MachineName: string): IMXWriter; + end; + +// *********************************************************************// +// The Class CoSAXAttributes provides a Create and CreateRemote method to +// create instances of the default interface IMXAttributes exposed by +// the CoClass SAXAttributes. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXAttributes = class + class function Create: IMXAttributes; + class function CreateRemote(const MachineName: string): IMXAttributes; + end; + +// *********************************************************************// +// The Class CoSAXAttributes30 provides a Create and CreateRemote method to +// create instances of the default interface IMXAttributes exposed by +// the CoClass SAXAttributes30. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXAttributes30 = class + class function Create: IMXAttributes; + class function CreateRemote(const MachineName: string): IMXAttributes; + end; + +// *********************************************************************// +// The Class CoSAXAttributes40 provides a Create and CreateRemote method to +// create instances of the default interface IMXAttributes exposed by +// the CoClass SAXAttributes40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXAttributes40 = class + class function Create: IMXAttributes; + class function CreateRemote(const MachineName: string): IMXAttributes; + end; + +// *********************************************************************// +// The Class CoSAXAttributes60 provides a Create and CreateRemote method to +// create instances of the default interface IMXAttributes exposed by +// the CoClass SAXAttributes60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSAXAttributes60 = class + class function Create: IMXAttributes; + class function CreateRemote(const MachineName: string): IMXAttributes; + end; + +// *********************************************************************// +// The Class CoMXNamespaceManager provides a Create and CreateRemote method to +// create instances of the default interface IVBMXNamespaceManager exposed by +// the CoClass MXNamespaceManager. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXNamespaceManager = class + class function Create: IVBMXNamespaceManager; + class function CreateRemote(const MachineName: string): IVBMXNamespaceManager; + end; + +// *********************************************************************// +// The Class CoMXNamespaceManager40 provides a Create and CreateRemote method to +// create instances of the default interface IVBMXNamespaceManager exposed by +// the CoClass MXNamespaceManager40. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXNamespaceManager40 = class + class function Create: IVBMXNamespaceManager; + class function CreateRemote(const MachineName: string): IVBMXNamespaceManager; + end; + +// *********************************************************************// +// The Class CoMXNamespaceManager60 provides a Create and CreateRemote method to +// create instances of the default interface IVBMXNamespaceManager exposed by +// the CoClass MXNamespaceManager60. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoMXNamespaceManager60 = class + class function Create: IVBMXNamespaceManager; + class function CreateRemote(const MachineName: string): IVBMXNamespaceManager; + end; + +implementation + +uses ComObj; + +class function CoDOMDocument.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_DOMDocument) as IXMLDOMDocument2; +end; + +class function CoDOMDocument.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMDocument) as IXMLDOMDocument2; +end; + +class function CoDOMDocument26.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_DOMDocument26) as IXMLDOMDocument2; +end; + +class function CoDOMDocument26.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMDocument26) as IXMLDOMDocument2; +end; + +class function CoDOMDocument30.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_DOMDocument30) as IXMLDOMDocument2; +end; + +class function CoDOMDocument30.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMDocument30) as IXMLDOMDocument2; +end; + +class function CoDOMDocument40.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_DOMDocument40) as IXMLDOMDocument2; +end; + +class function CoDOMDocument40.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMDocument40) as IXMLDOMDocument2; +end; + +class function CoDOMDocument60.Create: IXMLDOMDocument3; +begin + Result := CreateComObject(CLASS_DOMDocument60) as IXMLDOMDocument3; +end; + +class function CoDOMDocument60.CreateRemote(const MachineName: string): IXMLDOMDocument3; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DOMDocument60) as IXMLDOMDocument3; +end; + +class function CoFreeThreadedDOMDocument.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_FreeThreadedDOMDocument) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FreeThreadedDOMDocument) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument26.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_FreeThreadedDOMDocument26) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument26.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FreeThreadedDOMDocument26) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument30.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_FreeThreadedDOMDocument30) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument30.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FreeThreadedDOMDocument30) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument40.Create: IXMLDOMDocument2; +begin + Result := CreateComObject(CLASS_FreeThreadedDOMDocument40) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument40.CreateRemote(const MachineName: string): IXMLDOMDocument2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FreeThreadedDOMDocument40) as IXMLDOMDocument2; +end; + +class function CoFreeThreadedDOMDocument60.Create: IXMLDOMDocument3; +begin + Result := CreateComObject(CLASS_FreeThreadedDOMDocument60) as IXMLDOMDocument3; +end; + +class function CoFreeThreadedDOMDocument60.CreateRemote(const MachineName: string): IXMLDOMDocument3; +begin + Result := CreateRemoteComObject(MachineName, CLASS_FreeThreadedDOMDocument60) as IXMLDOMDocument3; +end; + +class function CoXMLSchemaCache.Create: IXMLDOMSchemaCollection; +begin + Result := CreateComObject(CLASS_XMLSchemaCache) as IXMLDOMSchemaCollection; +end; + +class function CoXMLSchemaCache.CreateRemote(const MachineName: string): IXMLDOMSchemaCollection; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLSchemaCache) as IXMLDOMSchemaCollection; +end; + +class function CoXMLSchemaCache26.Create: IXMLDOMSchemaCollection; +begin + Result := CreateComObject(CLASS_XMLSchemaCache26) as IXMLDOMSchemaCollection; +end; + +class function CoXMLSchemaCache26.CreateRemote(const MachineName: string): IXMLDOMSchemaCollection; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLSchemaCache26) as IXMLDOMSchemaCollection; +end; + +class function CoXMLSchemaCache30.Create: IXMLDOMSchemaCollection; +begin + Result := CreateComObject(CLASS_XMLSchemaCache30) as IXMLDOMSchemaCollection; +end; + +class function CoXMLSchemaCache30.CreateRemote(const MachineName: string): IXMLDOMSchemaCollection; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLSchemaCache30) as IXMLDOMSchemaCollection; +end; + +class function CoXMLSchemaCache40.Create: IXMLDOMSchemaCollection2; +begin + Result := CreateComObject(CLASS_XMLSchemaCache40) as IXMLDOMSchemaCollection2; +end; + +class function CoXMLSchemaCache40.CreateRemote(const MachineName: string): IXMLDOMSchemaCollection2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLSchemaCache40) as IXMLDOMSchemaCollection2; +end; + +class function CoXMLSchemaCache60.Create: IXMLDOMSchemaCollection2; +begin + Result := CreateComObject(CLASS_XMLSchemaCache60) as IXMLDOMSchemaCollection2; +end; + +class function CoXMLSchemaCache60.CreateRemote(const MachineName: string): IXMLDOMSchemaCollection2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLSchemaCache60) as IXMLDOMSchemaCollection2; +end; + +class function CoXSLTemplate.Create: IXSLTemplate; +begin + Result := CreateComObject(CLASS_XSLTemplate) as IXSLTemplate; +end; + +class function CoXSLTemplate.CreateRemote(const MachineName: string): IXSLTemplate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XSLTemplate) as IXSLTemplate; +end; + +class function CoXSLTemplate26.Create: IXSLTemplate; +begin + Result := CreateComObject(CLASS_XSLTemplate26) as IXSLTemplate; +end; + +class function CoXSLTemplate26.CreateRemote(const MachineName: string): IXSLTemplate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XSLTemplate26) as IXSLTemplate; +end; + +class function CoXSLTemplate30.Create: IXSLTemplate; +begin + Result := CreateComObject(CLASS_XSLTemplate30) as IXSLTemplate; +end; + +class function CoXSLTemplate30.CreateRemote(const MachineName: string): IXSLTemplate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XSLTemplate30) as IXSLTemplate; +end; + +class function CoXSLTemplate40.Create: IXSLTemplate; +begin + Result := CreateComObject(CLASS_XSLTemplate40) as IXSLTemplate; +end; + +class function CoXSLTemplate40.CreateRemote(const MachineName: string): IXSLTemplate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XSLTemplate40) as IXSLTemplate; +end; + +class function CoXSLTemplate60.Create: IXSLTemplate; +begin + Result := CreateComObject(CLASS_XSLTemplate60) as IXSLTemplate; +end; + +class function CoXSLTemplate60.CreateRemote(const MachineName: string): IXSLTemplate; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XSLTemplate60) as IXSLTemplate; +end; + +class function CoDSOControl.Create: IDSOControl; +begin + Result := CreateComObject(CLASS_DSOControl) as IDSOControl; +end; + +class function CoDSOControl.CreateRemote(const MachineName: string): IDSOControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSOControl) as IDSOControl; +end; + +class function CoDSOControl26.Create: IDSOControl; +begin + Result := CreateComObject(CLASS_DSOControl26) as IDSOControl; +end; + +class function CoDSOControl26.CreateRemote(const MachineName: string): IDSOControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSOControl26) as IDSOControl; +end; + +class function CoDSOControl30.Create: IDSOControl; +begin + Result := CreateComObject(CLASS_DSOControl30) as IDSOControl; +end; + +class function CoDSOControl30.CreateRemote(const MachineName: string): IDSOControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSOControl30) as IDSOControl; +end; + +class function CoDSOControl40.Create: IDSOControl; +begin + Result := CreateComObject(CLASS_DSOControl40) as IDSOControl; +end; + +class function CoDSOControl40.CreateRemote(const MachineName: string): IDSOControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_DSOControl40) as IDSOControl; +end; + +class function CoXMLHTTP.Create: IXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_XMLHTTP) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP.CreateRemote(const MachineName: string): IXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLHTTP) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP26.Create: IXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_XMLHTTP26) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP26.CreateRemote(const MachineName: string): IXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLHTTP26) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP30.Create: IXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_XMLHTTP30) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP30.CreateRemote(const MachineName: string): IXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLHTTP30) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP40.Create: IXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_XMLHTTP40) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP40.CreateRemote(const MachineName: string): IXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLHTTP40) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP60.Create: IXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_XMLHTTP60) as IXMLHTTPRequest; +end; + +class function CoXMLHTTP60.CreateRemote(const MachineName: string): IXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_XMLHTTP60) as IXMLHTTPRequest; +end; + +class function CoServerXMLHTTP.Create: IServerXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_ServerXMLHTTP) as IServerXMLHTTPRequest; +end; + +class function CoServerXMLHTTP.CreateRemote(const MachineName: string): IServerXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerXMLHTTP) as IServerXMLHTTPRequest; +end; + +class function CoServerXMLHTTP30.Create: IServerXMLHTTPRequest; +begin + Result := CreateComObject(CLASS_ServerXMLHTTP30) as IServerXMLHTTPRequest; +end; + +class function CoServerXMLHTTP30.CreateRemote(const MachineName: string): IServerXMLHTTPRequest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerXMLHTTP30) as IServerXMLHTTPRequest; +end; + +class function CoServerXMLHTTP40.Create: IServerXMLHTTPRequest2; +begin + Result := CreateComObject(CLASS_ServerXMLHTTP40) as IServerXMLHTTPRequest2; +end; + +class function CoServerXMLHTTP40.CreateRemote(const MachineName: string): IServerXMLHTTPRequest2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerXMLHTTP40) as IServerXMLHTTPRequest2; +end; + +class function CoServerXMLHTTP60.Create: IServerXMLHTTPRequest2; +begin + Result := CreateComObject(CLASS_ServerXMLHTTP60) as IServerXMLHTTPRequest2; +end; + +class function CoServerXMLHTTP60.CreateRemote(const MachineName: string): IServerXMLHTTPRequest2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ServerXMLHTTP60) as IServerXMLHTTPRequest2; +end; + +class function CoSAXXMLReader.Create: IVBSAXXMLReader; +begin + Result := CreateComObject(CLASS_SAXXMLReader) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader.CreateRemote(const MachineName: string): IVBSAXXMLReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXXMLReader) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader30.Create: IVBSAXXMLReader; +begin + Result := CreateComObject(CLASS_SAXXMLReader30) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader30.CreateRemote(const MachineName: string): IVBSAXXMLReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXXMLReader30) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader40.Create: IVBSAXXMLReader; +begin + Result := CreateComObject(CLASS_SAXXMLReader40) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader40.CreateRemote(const MachineName: string): IVBSAXXMLReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXXMLReader40) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader60.Create: IVBSAXXMLReader; +begin + Result := CreateComObject(CLASS_SAXXMLReader60) as IVBSAXXMLReader; +end; + +class function CoSAXXMLReader60.CreateRemote(const MachineName: string): IVBSAXXMLReader; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXXMLReader60) as IVBSAXXMLReader; +end; + +class function CoMXXMLWriter.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXXMLWriter) as IMXWriter; +end; + +class function CoMXXMLWriter.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXXMLWriter) as IMXWriter; +end; + +class function CoMXXMLWriter30.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXXMLWriter30) as IMXWriter; +end; + +class function CoMXXMLWriter30.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXXMLWriter30) as IMXWriter; +end; + +class function CoMXXMLWriter40.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXXMLWriter40) as IMXWriter; +end; + +class function CoMXXMLWriter40.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXXMLWriter40) as IMXWriter; +end; + +class function CoMXXMLWriter60.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXXMLWriter60) as IMXWriter; +end; + +class function CoMXXMLWriter60.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXXMLWriter60) as IMXWriter; +end; + +class function CoMXHTMLWriter.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXHTMLWriter) as IMXWriter; +end; + +class function CoMXHTMLWriter.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXHTMLWriter) as IMXWriter; +end; + +class function CoMXHTMLWriter30.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXHTMLWriter30) as IMXWriter; +end; + +class function CoMXHTMLWriter30.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXHTMLWriter30) as IMXWriter; +end; + +class function CoMXHTMLWriter40.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXHTMLWriter40) as IMXWriter; +end; + +class function CoMXHTMLWriter40.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXHTMLWriter40) as IMXWriter; +end; + +class function CoMXHTMLWriter60.Create: IMXWriter; +begin + Result := CreateComObject(CLASS_MXHTMLWriter60) as IMXWriter; +end; + +class function CoMXHTMLWriter60.CreateRemote(const MachineName: string): IMXWriter; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXHTMLWriter60) as IMXWriter; +end; + +class function CoSAXAttributes.Create: IMXAttributes; +begin + Result := CreateComObject(CLASS_SAXAttributes) as IMXAttributes; +end; + +class function CoSAXAttributes.CreateRemote(const MachineName: string): IMXAttributes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXAttributes) as IMXAttributes; +end; + +class function CoSAXAttributes30.Create: IMXAttributes; +begin + Result := CreateComObject(CLASS_SAXAttributes30) as IMXAttributes; +end; + +class function CoSAXAttributes30.CreateRemote(const MachineName: string): IMXAttributes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXAttributes30) as IMXAttributes; +end; + +class function CoSAXAttributes40.Create: IMXAttributes; +begin + Result := CreateComObject(CLASS_SAXAttributes40) as IMXAttributes; +end; + +class function CoSAXAttributes40.CreateRemote(const MachineName: string): IMXAttributes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXAttributes40) as IMXAttributes; +end; + +class function CoSAXAttributes60.Create: IMXAttributes; +begin + Result := CreateComObject(CLASS_SAXAttributes60) as IMXAttributes; +end; + +class function CoSAXAttributes60.CreateRemote(const MachineName: string): IMXAttributes; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SAXAttributes60) as IMXAttributes; +end; + +class function CoMXNamespaceManager.Create: IVBMXNamespaceManager; +begin + Result := CreateComObject(CLASS_MXNamespaceManager) as IVBMXNamespaceManager; +end; + +class function CoMXNamespaceManager.CreateRemote(const MachineName: string): IVBMXNamespaceManager; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXNamespaceManager) as IVBMXNamespaceManager; +end; + +class function CoMXNamespaceManager40.Create: IVBMXNamespaceManager; +begin + Result := CreateComObject(CLASS_MXNamespaceManager40) as IVBMXNamespaceManager; +end; + +class function CoMXNamespaceManager40.CreateRemote(const MachineName: string): IVBMXNamespaceManager; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXNamespaceManager40) as IVBMXNamespaceManager; +end; + +class function CoMXNamespaceManager60.Create: IVBMXNamespaceManager; +begin + Result := CreateComObject(CLASS_MXNamespaceManager60) as IVBMXNamespaceManager; +end; + +class function CoMXNamespaceManager60.CreateRemote(const MachineName: string): IVBMXNamespaceManager; +begin + Result := CreateRemoteComObject(MachineName, CLASS_MXNamespaceManager60) as IVBMXNamespaceManager; +end; + +end.