01-12-2017, Saat: 13:51
FireDAC'ı incelemeye başlamışken, Asenkron işlemler için bir helper yazmak ve bunu sizlerin de görüşüne sunmak istedim. Müspet/menfi yorumlarınız dikkate alınır
Eklememi/Çıkartmamı/Değiştirmemi istediğiniz yer var mıdır ?
Eklememi/Çıkartmamı/Değiştirmemi istediğiniz yer var mıdır ?
(* Created by Tuğrul HELVACI 24/11/2017 AllahRazıOlsunWare (Gönül rahatlığı ile kullanabilirsiniz) *) unit Sekom.FireDAC.Helpers; interface uses System.SysUtils, System.Variants, System.Classes, System.SyncObjs, Generics.Defaults, Generics.Collections, Data.DB, FireDAC.Stan.Error, FireDac.Stan.Option, FireDac.Stan.Intf, FireDac.Stan.Param, FireDac.Phys.Intf, FireDac.Comp.Client, // For TFDStoredProc FireDac.Comp.DataSet; type TAsyncBeforeOpen = reference to procedure(const ADataSet : TFDStoredProc); TAsyncAfterOpen = reference to procedure(const ADataSet : TFDStoredProc); TAsyncBeforeSave = reference to procedure(const ADataSet : TFDStoredProc); TAsyncAfterSave = reference to procedure(const ADataSet : TFDStoredProc); TAsyncError = reference to procedure(const AError : Exception); TFiredacStoredProcedureHelper = class helper for TFDStoredProc public procedure OpenAsync( const AExecutionMessage : String; const AParamNames : array of String; const AParamValues : array of Variant; const AError : TAsyncError = nil; const ABeforeOpen : TAsyncBeforeOpen = nil; const AAfterOpen : TAsyncAfterOpen = nil ); overload; procedure OpenAsync( const AExecutionMessage : String; const AParams : TDictionary<String, Variant>; const AError : TAsyncError = nil; const ABeforeOpen : TAsyncBeforeOpen = nil; const AAfterOpen : TAsyncAfterOpen = nil ); overload; //Burada da Cached updates üzerinden dataları okuyup, ilgili sp leri çalıştıracağız. //Transaction da olacak tabii. Aynı zamanda progress bar da olsun. Kayıtlar siliniyor, %d/%d, kayıtlar ekleniyor %d/%d, //kayıtlar güncelleniyor %d/%d gibi. procedure SaveAsync( const AInsertProcedureName : String; const AUpdateProcedureName : String; const ADeleteProcedureName : String; const ABeforSave : TAsyncBeforeSave = nil; const AAfterSave : TAsyncAfterSave = nil ); end; implementation uses Vcl.Dialogs, Vcl.Forms, Vcl.Controls, WinAPI.Windows, WinAPI.CommCtrl, Winapi.Messages; const cCancelAsync = -1453; type TTaskDialog = class sealed(Vcl.Dialogs.TTaskDialog) private procedure InternalButtonClicked(Sender: TObject; ModalResult: TModalResult; var CanClose: Boolean); public ACanClose : Boolean; end; TTaskDialogHelper = class helper for TTaskDialog private procedure DialogCreated(Sender : TObject); public procedure ExecuteAsync(const AProc : TProc); end; TEventHandlers = class private AsyncErrorProc : TAsyncError; public constructor Create; procedure AsyncErrorHandler(ASender, AInitiator: TObject; var AException: Exception); end; var EventHandlers : TEventHandlers = nil; function CreateTaskDialogForAsyncOpen : TTaskDialog; var AItem : TTaskDialogBaseButtonItem; begin Result := TTaskDialog.Create(nil); Result.Caption := Application.Title; Result.CommonButtons := []; Result.Flags := [tfShowMarqueeProgressBar]; Result.FooterIcon := tdiShield; Result.MainIcon := tdiInformation; Result.Title := 'Bilgilendirme'; Result.OnButtonClicked := Result.InternalButtonClicked; AItem := Result.Buttons.Add; AItem.Caption := 'Sorguyu Durdur'; AItem.ModalResult := TModalResult(cCancelAsync); end; function CreateTaskDialogForAsyncSave : TTaskDialog; var AItem : TTaskDialogBaseButtonItem; begin Result := TTaskDialog.Create(nil); Result.Caption := Application.Title; Result.CommonButtons := []; Result.Flags := [tfShowProgressBar]; Result.FooterIcon := tdiShield; Result.MainIcon := tdiInformation; Result.Title := 'Bilgilendirme'; Result.OnButtonClicked := Result.InternalButtonClicked; AItem := Result.Buttons.Add; AItem.Caption := 'Sorguyu Durdur'; AItem.ModalResult := TModalResult(cCancelAsync); end; function CreateTaskDialogForException : TTaskDialog; begin Result := TTaskDialog.Create(nil); Result.Caption := Application.Title; Result.CommonButtons := [tcbOk]; Result.Flags := []; Result.FooterIcon := tdiShield; Result.MainIcon := tdiError; Result.Title := 'Bilgilendirme'; end; procedure BringWindowFront(const AWindowHandle : THandle); var SwitchToThisWindow : procedure(AHandle : HWND; AltTab : BOOL); stdcall; begin @SwitchToThisWindow := GetProcAddress(GetModuleHandle(user32), 'SwitchToThisWindow'); if @SwitchToThisWindow <> nil then SwitchToThisWindow(AWindowHandle, true) else BringWindowToTop(AWindowHandle); end; { TFiredacStoredProcedureHelper } procedure TFiredacStoredProcedureHelper.OpenAsync( const AExecutionMessage : String; const AParamNames : array of String; const AParamValues : array of Variant; const AError : TAsyncError = nil; const ABeforeOpen : TAsyncBeforeOpen = nil; const AAfterOpen : TAsyncAfterOpen = nil ); var ADictionary : TDictionary<String, Variant>; AParamName : String; AParamValue : Variant; iCounter : Integer; begin Self.Close; Self.FetchOptions.Mode := TFDFetchMode.fmAll; Self.ResourceOptions.CmdExecMode := TFDStanAsyncMode.amAsync; ADictionary := TDictionary<String, Variant>.Create(); try for iCounter := 0 to Length(AParamNames) - 1 do begin AParamName := AParamNames[iCounter]; AParamValue:= AParamValues[iCounter]; ADictionary.AddOrSetValue(AParamName, AParamValue); end; OpenAsync(AExecutionMessage, ADictionary, AError, ABeforeOpen, AAfterOpen); finally if Assigned(ADictionary) then FreeAndNil(ADictionary); end; // try..finally end; procedure TFiredacStoredProcedureHelper.OpenAsync( const AExecutionMessage : String; const AParams : TDictionary<String, Variant>; const AError : TAsyncError = nil; const ABeforeOpen : TAsyncBeforeOpen = nil; const AAfterOpen : TAsyncAfterOpen = nil ); var AParamName : String; AParamValue : Variant; iCounter : Integer; AParam : TFDParam; ADialog : TTaskDialog; AParent : TComponent; AWindowHandle : HWND; begin if not Assigned(Self.OnError) then begin Self.OnError := EventHandlers.AsyncErrorHandler; EventHandlers.AsyncErrorProc := AError; end; Self.Prepare; // First initialize NULL params for iCounter := 0 to Self.Params.Count - 1 do Self.Params[iCounter].Value := Null; if Assigned(ABeforeOpen) then ABeforeOpen(Self); if AParams.Count > 0 then for AParamName in AParams.Keys do begin AParamValue := AParams.Items[AParamName]; AParam := Self.Params.FindParam(AParamName); if Assigned(AParam) then AParam.Value := AParamValue; end; // for AParamName in AParams.Keys do Self.Open(); // Wait dialog çıkart ve gereken işlemleri yap. Cancelable gibi.. ADialog := CreateTaskDialogForAsyncOpen; try ADialog.Tag := NativeInt(Self); ADialog.Text := AExecutionMessage; ADialog.ExecuteAsync( procedure begin while Self.Command.State = TFDPhysCommandState.csExecuting do Application.ProcessMessages; Sleep(500); end ); finally if Assigned(ADialog) then FreeAndNil(ADialog); end; if Assigned(AAfterOpen) then AAfterOpen(Self); {$REGION 'BringWindowToTop'} AWindowHandle := 0; AParent := Self.GetParentComponent; if not Assigned(AParent) then AParent := Self.Owner; if Assigned(AParent) then if AParent.InheritsFrom(TCustomForm) then AWindowHandle := TCustomForm(AParent).Handle; if AWindowHandle = 0 then if Assigned(Application) then if Assigned(Application.MainForm) then AWindowHandle := Application.MainForm.Handle; if AWindowHandle = 0 then AWindowHandle := Application.Handle; if AWindowHandle <> 0 then BringWindowFront(AWindowHandle); {$ENDREGION} end; procedure TFiredacStoredProcedureHelper.SaveAsync( const AInsertProcedureName : String; const AUpdateProcedureName : String; const ADeleteProcedureName : String; const ABeforSave : TAsyncBeforeSave = nil; const AAfterSave : TAsyncAfterSave = nil ); var ADialog : TTaskDialog; ACancelEvent : TEvent; AParent : TComponent; AWindowHandle : HWND; ACancelled : Boolean; begin ACancelled := false; {$REGION 'Checking'} // Checking.... if not Self.CachedUpdates then raise Exception.Create('Dataset is not in cached uptades mode.!'); if not Self.UpdatesPending then raise Exception.Create('Could not found any pending updates.!'); if Self.ChangeCount <= 0 then raise Exception.Create('Dataset has no any changes.!'); if AInsertProcedureName.IsEmpty and AUpdateProcedureName.IsEmpty and ADeleteProcedureName.IsEmpty then raise Exception.Create('Procedure names could not be empty.!'); if not Assigned(Self.Connection) then raise Exception.Create('Connection could not be empty.!'); if not Self.Connection.Connected then try // Açmaya çalışalım... Self.Connection.Open(); except raise Exception.Create('Connection could not established.!'); end; // Checking.... {$ENDREGION} // Wait dialog çıkart ve gereken işlemleri yap. Cancelable gibi.. ADialog := CreateTaskDialogForAsyncSave; ACancelEvent := TEvent.Create(nil, true, false, ''); try ADialog.Tag := NativeInt(ACancelEvent); ADialog.ExecuteAsync( procedure procedure FillParams(const ASource : TFDMemTable; const ATarget : TFDStoredProc); var ASourceField : TField; ATargetParam : TFDParam; begin for ASourceField in ASource.Fields do begin ATargetParam := ATarget.FindParam('@' + ASourceField.FieldName); if Assigned(ATargetParam) then ATargetParam.Value := ASourceField.Value; end; end; procedure ShowInfo(const AMessage : String); begin ADialog.Text := AMessage; Sleep(100); end; var AConnection : TFDConnection; AProcedure : TFDStoredProc; AMemory : TFDMemTable; begin AConnection := TFDConnection(Self.Connection.CloneConnection); AProcedure := TFDStoredProc.Create(nil); AMemory := TFDMemTable.Create(nil); try if not AConnection.Connected then AConnection.Open(); AConnection.StartTransaction; AProcedure.Connection := AConnection; {$REGION 'Deletes'} // Deletes if not ADeleteProcedureName.IsEmpty then begin ADialog.ProgressBar.Position := 0; ShowInfo('Silinecek kayıtlar kontrol ediliyor...'); AMemory.Close; AMemory.FilterChanges := [rtDeleted]; AMemory.Data := Self.Delta; if not AMemory.Active then AMemory.Open; if AMemory.RecordCount > 0 then begin ADialog.ProgressBar.Max := AMemory.RecordCount; AProcedure.Close; AProcedure.StoredProcName := ADeleteProcedureName; AProcedure.Prepare; while (not AMemory.Eof) and (ACancelEvent.WaitFor(0) <> wrSignaled) do begin ShowInfo(Format('%d/%d siliniyor...', [AMemory.RecNo, AMemory.RecordCount])); FillParams(AMemory, AProcedure); try AProcedure.ExecProc; except if AConnection.InTransaction then AConnection.Rollback; raise; end; AMemory.Next; ADialog.ProgressBar.Position := ADialog.ProgressBar.Position + 1; end; // while not AMemory.Eof do end; // if AMemory.RecordCount > 0 then end; {$ENDREGION} {$REGION 'Updates'} // Updates if not AUpdateProcedureName.IsEmpty then begin ADialog.ProgressBar.Position := 0; ShowInfo('Güncellenecek kayıtlar kontrol ediliyor...'); AMemory.Close; AMemory.FilterChanges := [rtModified]; AMemory.Data := Self.Delta; if not AMemory.Active then AMemory.Open; if AMemory.RecordCount > 0 then begin ADialog.ProgressBar.Max := AMemory.RecordCount; AProcedure.Close; AProcedure.StoredProcName := AUpdateProcedureName; AProcedure.Prepare; while (not AMemory.Eof) and (ACancelEvent.WaitFor(0) <> wrSignaled) do begin ShowInfo(Format('%d/%d güncelleniyor...', [AMemory.RecNo, AMemory.RecordCount])); FillParams(AMemory, AProcedure); try AProcedure.ExecProc; except if AConnection.InTransaction then AConnection.Rollback; raise; end; AMemory.Next; ADialog.ProgressBar.Position := ADialog.ProgressBar.Position + 1; end; // while not AMemory.Eof do end; // if AMemory.RecordCount > 0 then end; {$ENDREGION} {$REGION 'Inserts'} // Inserts if not AInsertProcedureName.IsEmpty then begin ADialog.ProgressBar.Position := 0; ShowInfo('Eklenecek kayıtlar kontrol ediliyor...'); AMemory.Close; AMemory.FilterChanges := [rtInserted]; AMemory.Data := Self.Delta; if not AMemory.Active then AMemory.Open; if AMemory.RecordCount > 0 then begin ADialog.ProgressBar.Max := AMemory.RecordCount; AProcedure.Close; AProcedure.StoredProcName := AInsertProcedureName; AProcedure.Prepare; while (not AMemory.Eof) and (ACancelEvent.WaitFor(0) <> wrSignaled) do begin ShowInfo(Format('%d/%d ekleniyor...', [AMemory.RecNo, AMemory.RecordCount])); FillParams(AMemory, AProcedure); try AProcedure.ExecProc; except if AConnection.InTransaction then AConnection.Rollback; raise; end; AMemory.Next; ADialog.ProgressBar.Position := ADialog.ProgressBar.Position + 1; end; // while not AMemory.Eof do end; // if AMemory.RecordCount > 0 then end; // if not AInsertProcedureName.IsEmpty then {$ENDREGION} finally if ACancelEvent.WaitFor(0) = wrSignaled then if AConnection.InTransaction then AConnection.Rollback; if AConnection.InTransaction then AConnection.Commit; if Assigned(AProcedure) then FreeAndNil(AProcedure); if Assigned(AConnection) then FreeAndNil(AConnection); if Assigned(AMemory) then FreeAndNil(AMemory); end; // try..finally end ); // ADialog.ExecuteAsync( finally if Assigned(ADialog) then FreeAndNil(ADialog); if Assigned(ACancelEvent) then begin ACancelled := ACancelEvent.WaitFor(10) = wrSignaled; FreeAndNil(ACancelEvent); end; end; if not ACancelled then if Assigned(AAfterSave) then AAfterSave(Self); {$REGION 'BringWindowToTop'} AWindowHandle := 0; AParent := Self.GetParentComponent; if not Assigned(AParent) then AParent := Self.Owner; if Assigned(AParent) then if AParent.InheritsFrom(TCustomForm) then AWindowHandle := TCustomForm(AParent).Handle; if AWindowHandle = 0 then if Assigned(Application) then if Assigned(Application.MainForm) then AWindowHandle := Application.MainForm.Handle; if AWindowHandle = 0 then AWindowHandle := Application.Handle; if AWindowHandle <> 0 then BringWindowFront(AWindowHandle); {$ENDREGION} end; { TTaskDialogHelper } procedure TTaskDialogHelper.DialogCreated(Sender: TObject); begin SendMessage(Handle, TDM_ENABLE_BUTTON, IDOK, 0); SendMessage(Handle, TDM_ENABLE_BUTTON, IDCancel, 0); end; procedure TTaskDialogHelper.ExecuteAsync(const AProc: TProc); var AThread : TThread; ADialog : TTaskDialog; InternalException : Exception; AExceptionMessage : String; begin AExceptionMessage := ''; InternalException := nil; ADialog := Self; AThread := TThread.CreateAnonymousThread( procedure //var //AExceptObject : TObject; //AExceptionMessage : String; begin ADialog.ACanClose := false; Sleep(1000); SendMessage(Handle, TDM_ENABLE_BUTTON, IDOK, 0);//mrOK, 0); SendMessage(Handle, TDM_ENABLE_BUTTON, IDCANCEL, 0);//mrCancel, 0); SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE); try AProc; except ADialog.ACanClose := true; SendMessage(Handle, TDM_ENABLE_BUTTON, IDOK, 1); //mrOK, 1); SendMessage(Handle, TDM_ENABLE_BUTTON, IDCANCEL, 1); //mrCancel, 1); SendMessage(Handle, TDM_CLICK_BUTTON, IDOK, 0); //mrOk, 0); InternalException := AcquireExceptionObject; (* AExceptObject := ExceptObject; if Assigned(AExceptObject) then if AExceptObject is Exception then begin AExceptionMessage := Exception(AExceptObject).Message; end; *) end; ADialog.ACanClose := true; SendMessage(Handle, TDM_ENABLE_BUTTON, IDOK, 1); //mrOK, 1); SendMessage(Handle, TDM_ENABLE_BUTTON, IDCANCEL, 1); //mrCancel, 1); SendMessage(Handle, TDM_CLICK_BUTTON, IDOK, 0); //mrOk, 0); end ); AThread.Start; (* Önemli Not: TaskDialog'un Execute metoduna geçirilen ParentHWND uygulamanın içindeki bir pencere ise, uygulamanın main thread'i donduğunda haliyle TaskDialog'da donuyor idi. Bu nedenle, ParentHWND uygulama ile alakası olmayan GetDesktopWindow olarak geçildi. Bu sayede uygulamanın main thread'i bloklansada TaskDialog bloklanmamış oluyor. *) Execute(GetDesktopWindow); if Assigned(InternalException) then raise InternalException; //if not AExceptionMessage.IsEmpty then //raise Exception.Create(AExceptionMessage); end; { TTaskDialog } procedure TTaskDialog.InternalButtonClicked(Sender: TObject; ModalResult: TModalResult; var CanClose: Boolean); var AnObject : TObject; begin if ModalResult = TModalResult(cCancelAsync) then begin AnObject := TObject(Self.Tag); if Assigned(AnObject) then begin if AnObject.InheritsFrom(TFDStoredProc) then TFDStoredProc(AnObject).AbortJob(true); if AnObject.InheritsFrom(TFDConnection) then TFDConnection(AnObject).AbortJob(true); if AnObject.InheritsFrom(TEvent) then begin TEvent(AnObject).SetEvent; CanClose := false; end; end; // if Assigned(AnObject) then end; // if ModalResult = TModalResult(cCancelAsync) then end; { TEventHandlers } procedure TEventHandlers.AsyncErrorHandler(ASender, AInitiator: TObject; var AException: Exception); var ExceptionMessage : String; ADialog : TTaskDialog; begin if ASender is TFDStoredProc then TFDStoredProc(ASender).OnError := nil; if Assigned(AsyncErrorProc) then AsyncErrorProc(AException) else begin ExceptionMessage := AException.Message; TThread.Queue( nil, procedure begin ADialog := CreateTaskDialogForException; try ADialog.Text := ExceptionMessage; ADialog.Execute; finally if Assigned(ADialog) then FreeAndNil(ADialog); end; end ); end; AsyncErrorProc := nil; end; constructor TEventHandlers.Create; begin inherited Create; AsyncErrorProc := nil; end; initialization EventHandlers := TEventHandlers.Create; finalization EventHandlers.Free; end.