Jump to content


  • Content Count

  • Joined

  • Last visited

Everything posted by PatV

  1. PatV

    GMail Inbox

    Hi All, I'm searching a way to remove the Tag 'Inbox' from message. I try to send command, via IdImap4.SendCmd('C1','UID STORE '+rMess.UID+' -X-GM-LABELS ("Inbox")',['OK','BAD','NO'], true); Without success. Any clues ? Regards Patrick
  2. PatV

    GMail Inbox

    Thanks a lot for the explanation Remy ! Patrick
  3. PatV

    GMail Inbox

    Hi Remy You are right about the extra spaces, I've got another message, now. S:C1 UID STORE 193 -X-GM-LABELS (\Inbox) R:C1 BAD UID STORE not allowed now. If found also the link you mentioned How to remove a label from an email message from Gmail by using the IMAP protocol? as this one too on witch you have replied. what-belongs-in-aexpectedresponses-parameter-to-tidimap4-sendcmd I've tried also the "move" command but I didn't get the good UID, my goal was to read messages header through RetrieveHeader, and move later message selected on a TVirtualStringTree, but It seems that once I close the imap connection, those uid are no more correct. IDImap4.SelectMailBox('INBOX'); IDImap4.SearchMailBox(aSearchInfo); iUID:=0; with IDImap4 do for i:=0 to High(MailBox.SearchResult) do begin iMsg:=TIdMessage.Create; iMsg.Clear; RetrieveHeader(MailBox.SearchResult[i],iMsg); sUID:=IntToStr(MailBox.SearchResult[i]); iUID:=MailBox.SearchResult[i]; rMess.WithMessage(iMsg).WithUID(sUID).WithNode(Nil).asUnSelected; AnArray.add<rMsg>(Msgs,rMess); end; FillVST; IdIMap4.Disconnect; I'll test the function tomorrow. IdImap4.UIDStoreValue(rMess.UID, sdRemove, 'X-GM-LABELS', '\Inbox'); Thanks again Patrick
  4. PatV

    GMail Inbox

    Hi Remy, Thanks for your component and your support, I've tried it also and get an error too. IdImap4.SendCmd('UID STORE ' + rMess.UID + ' -X-GM-LABELS (\Inbox)', ['OK','BAD','NO'], true); S:C1 UID STORE 189 -X-GM-LABELS (\Inbox) R:C1 BAD Could not parse command IdImap4.UIDStoreValue(rMess.UID, sdRemove, 'X-GM-LABELS', '\Inbox'); I didn't look at this function, I'll go with it Thanks Patrick
  5. Hi You can still use record and forget pointers TReminderItem = record FEmployeeID: Integer; FEmployeeName: String; FHireDate: TDate; FLastDate: TDate; FNotes: String; end; PReminderItem = ^TreminderItem; TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private procedure GetReminder(AList: TList<TReminderItem>); { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var LList : TList<TReminderItem>; LReminderItem : PReminderItem; begin LList := TList<TReminderItem>.Create; try GetReminder(LList); ShowMessage(Format('Name: %s', [LList[0].FEmployeeName])); finally // for LReminderItem in LList do // Dispose(LReminderItem); LList.Free; end; end; procedure TForm1.GetReminder(AList: TList<TReminderItem>); var LReminderItem : TReminderItem; begin // LReminderItem := TReminderItem.Create; LReminderItem:=default(TReminderITem); with LReminderItem do begin FEmployeeID := 1; FEmployeeName := 'Test Name'; FHireDate := Now; FLastDate := Now; FNotes := 'A Note'; end; AList.Add(LReminderItem); end;
  6. Hi Dalija, I've got your book, congrats, it is very helpful !!! Patrick
  7. Hi All, I'm using Parallel.Async to send an email, even if it's working, I would like to know if my approach is correct ; procedure TTFrmPanelPrint.SendMailParallel; var sRacine : string; sFrom,sName,sSubject,sBody : string; begin sRacine:=TPath.Combine(FReport.Directory ,FReport.FileName); sFrom := rUser(FReport.Print.Values[pspUser]^).Mail.GetMail; sName := rUser(FReport.Print.Values[pspUser]^).Name.FirstLastName; sBody :=Comment.Lines.Text; sSubject:= FFile.External; end; Parallel.Async ( Procedure(const task : IOmniTask) function AddAttach(const aRacine : string) : TStringList; var sFile : string; begin Result:=TStringList.Create; Result.Add(aRacine+cExtPdf); Result.Add(aRacine+cExtXlsx); for sFile in LBAttachments.Items do Result.Add(sFile); end; var sAttach,sTo,sBC,sCC : TSTringList; begin sAttach := AddAttach(sRacine); sTo :=TStringList.Create; sCC :=TStringList.Create; sBC :=TStringList.Create; sTo.Add(CbCommunication.Text); Task.Invoke ( procedure begin FMail.WithFrom(sFrom) .WithFromName(sName) .WithTo(sTo) .WithSubject(sSubject) .WithBody(sBody) .WithAttachments(sAttach) .WithPrcMailLog(LogAdd) .WithPrcOnDone(MailSendDone) .Send; sTo.Free; sCC.Free; sBC.Free; sAttach.Free; end ) end ); end; Thanks a lot Patrick
  8. PatV

    Sending Email via GMail Using OAuth 2.0 via Indy

    @Geoffrey Smith Thanks a lot for your sample on Github Patrick
  9. I'm working with Delphi 10.3.3 Hi all, does anyone have an idea for a project like this ; On a desktop, a software (master), and on a tablet (let's says surface) the slave. I would like to send the PDF or whatever from the master to the slave on runtime. What's the best approach to communicate between the 2 ? A thread communicating with a database ? or a communication channel between the master / slave ? Thanks Patrick
  10. Thanks I will look at. I really don't know if I'll play with Tcp/Ip Socket or something else.
  11. Delphi 10.3.2 TVirtualStringTree V 7.2.1 Hi All, I'm searching to add multiline to the header of a TVistualStringTree, does it exist already or do I need to use ownerdraw ? Thanks Patrick
  12. PatV

    TVirtualTreeView Header multilines

    found .. set coWrapCaption to True to the TVHeader.Columns[x].Options
  13. Hi all, Is it possible I have a race condition in a thread pool ? when I launch a task, I get a database connection from my database factory, but when the worker want to use it, Sometimes I've got an error message "mysql server has gone away", if I'm retrying after few sec, I didn't get the error message again, everything is working. Is there a specific status that a Thread from the thread pool is going to be destroyed ? Thanks Patrick FPoolSearch is definined as iOmniThreadPool; procedure TFrameCustomer.SearchForId(aValue : integer); var Params : TParameters; const cParam = 'I_IDCLI'; begin WithParamsReset(Params); WithParam(Params,cParam, aValue ,dtInteger); CreateTask(WorkerSearchId, GetTGUIDString ) .OnMessage(TaskMessage) .OnTerminated(TaskTerminated) .SetParameter('Params',TOmniValue.FromArray<rParameter>(Params)) .SetParameter('ProcName','prc_ClientSearchId') .Schedule(FPoolSearch); end; {------------------------------------------------------------------------} procedure WorkerSearchId(const task: IOmniTask); function FillData : TFCustomer; var aCust : TFCustomer; begin result:=TFCustomer.Create; with (task.ThreadData as TConnectionPoolData) do begin with DM.Proc do // Datamodule . Procedure begin WorkOnParams; // Inject parameters from the procedure Open; if RecordCount>0 then FilInfo(result,task); end; end; end; var aOVValue : TOmniValue; aRes : TFCustomer; begin (task.ThreadData as IConnectionPoolData) .WithProcedureName(task.Param['ProcName']) .WithParameters(task.Param['Params']); aRes := FillData; aOVValue := TOmniValue.CastFrom<TFCustomer>(TFCustomer.Clone(aRes)); aRes.Free; task.Comm.Send(MSG_SHOW,aOVValue); end;
  14. PatV

    OmniThreadPool race conditions

    ok, will check for Thanks PAtrick
  15. Delphi 10.3 Omnithead 3.07.5 Hi All, I'm just a little lost, I would like to pass parameters to the data factory, I know I can pass function like this TOTPThreadDataFactoryFunction = function: IInterface; TOTPThreadDataFactoryMethod = function: IInterface of object; and my function is like {-------------------------------------------------------------------------------------------------} function TFConfig.CreateThreadPool(aHandle : THandle ; aConfig : rConnectionConfig ; aValue: string) : iOmniThreadPool; var iOmniValue : TOmniValue; begin iOmniValue := TOmniValue.FromRecord<rConnectionConfig>(aconfig); result := otlThreadPool.CreateThreadPool(aValue); result.MaxExecuting := result.NumCores; result.SetThreadDataFactory ( (function (aHandle : THandle ; aConfig : TOmniValue) : IInterface begin result:=Function : IInterface begin result:= ?? end; end )(aHandle,iOmniValue ) ); end; {-------------------------------------------------------------------------------------------------} rConnectionConfig is a record containing info on to be able to connect to the datamodule RConnectionConfig = record User : string; Password : string; Database : string; Protocol : string; Port : integer; HostName : string; LibraryLocation : string; ModuleName : string; end; Could someone help me with this Thanks Patrick
  16. Hi, could someone tell me what's wrong here, I'm returning an IInterface as needed so ... [dcc32 Error] clsInit.pas(313): E2250 There is no overloaded version of 'SetThreadDataFactory' that can be called with these arguments ( in OtlThreadPool ; TOTPThreadDataFactoryFunction = function: IInterface; ) function TFConfig.CreateThreadPool(aHandle : THandle ; aConfig : rConnectionConfig ; aValue: string) : iOmniThreadPool; begin result := otlThreadPool.CreateThreadPool(aValue); result.MaxExecuting := result.NumCores; result.SetThreadDataFactory ( function : IInterface begin result:=CreateConnectionPoolData(aHandle,aConfig); end ); end; I have defined CreateConnectionPoolData as follow function CreateConnectionPoolData(const aHandle : THandle ; const aConfig : rConnectionConfig) : IInterface; var aPool : IConnectionPoolData; begin aPool := TConnectionPoolData.Create; aPool.WithHandle(aHandle).WithConnectionConfig(aConfig); result:=aPool; end; IConnectionPoolData = interface function WithHandle(const aValue : HWND) : IConnectionPoolData ; function WithConnectionConfig(aValue : rConnectionConfig) : IConnectionPoolData ; end; Thanks Patrick
  17. PatV


    So, I can't pass function or method with parameters then ?
  18. Thanks again Primož, So glad you are around. Patrick
  19. Delphi 10.3 Omnithead 3.07.5 Hi all, I'm testing and playing with the sample 24_ConnectionPool, so in the main form I've added procedure TfrmConnectionPoolDemo.btnScheduleClick(Sender: TObject); var i : integer; Params : TParameters; begin WithParamsReset(Params); WithParam(Params,cDteFrom,'2019/01/01',dtString); WithParam(Params,cDteTo ,'2019/09/01',dtString); for i:=0 to 99 do // for testing purpose launch 100 task begin Log(Format('Creating task %d',)); CreateTask(Worker,format('%0.2d',)) .MonitorWith(OTLMonitor) .SetParameter('Params',TOmniValue.FromArray<rParameter>(Params)) .SetParameter('ProcName','prc_ProcedureToCall') .Schedule(FConnectionPool); end; end; now my question is ; how can I retreive the result of the data connection in an object and send it from task Worker to the main thread ? I was thinking about msg.msgData from IOmniMessage and retreive it through OTLMonitor or insert a TOmniTaskInvokeFunction into my Worker task What is the best way ? Thanks Patrick
  20. Thanks again Primoz for your fast answer, I'll go with task.Comm.Send Regards Patrick
  21. Delphi 10.3 Omnithead 3.07.5 Hi All here is a definition of an array of .. TpDataType = (dtNone, dtInteger, dtDateTime, dtString, dtBlob); rParameter = record Field : string; Value : Variant; AsValue : TpDataType; end; TParameters = array of rParameter; I would like to pass it to a worker as parameter, so CreateTask(Worker) .MonitorWith(OTLMonitor) .SetParameter('Params',TOmniValue.Create([Params]); I've tried also .SetParameter('Params',TOmniValue.FromArray<TParameters>(Params)) and convert it again like function TConnectionPoolData.WithParameters(const aValue : TOmniValue) : IConnectionPoolData; begin FParams := aValue.CastTo<TParameters>; Result:=Self; end; But it's not working as expected, as I'm getting bunch of data Do I need to use a class instead ? Thanks Patrick
  22. Thanks a lot Primož, it helps me a lot. And thanks for sharing Omnithread Patrick
  23. Found the prob.... it's too quick, I need to introduce a delay in my loop and everything is working now if you have any suggestions, you're welcome Hi All, I'm using Delphi 10.3 As testing, I've a main form when I click on MyForm Create Thread Button, I launch the code bellow ; I create a form TForm.Create(Self) and I include a frame in it TFrm.Create(Self) GetTGUIDString simply convert number from TGIUID.NewGuid.ToString to letter, and remove special char to get a random name. In My Frame, I have defined a Thread ; TThDb = class(TThread) private FOwner : TComponent; FDM : TFDb; // is a datamodule who will be created within the tread FEvent : TEvent; FError : TFError; FRet : TFRet; FAgs : string; FWhenDone : PrcDone; procedure InitializeDatabase; procedure ConnectToDatabase; Procedure WorkOnData; function LoadData : TThDb; procedure Execute; override; public constructor Create(bSuspended : boolean); destructor Destroy; override; property Event : TEvent read FEvent write FEvent; function WhenDone(aValue : PrcDone) : TThDb; function WithAgencies(aValue : string) : TThDb; function WithOwner(aValue : TComponent) : TThDb; procedure Start; // initialise the connection to the database the first time procedure ReStart; // update the variable in the query/procedure end; {------------------------------------------------------------------------------} procedure TTHDB.InitializeDatabase; begin CoInitialize(Nil); FDM := TFDb.Create(nil); FDM.Connection.ReadOnly:=True; CoUninitialize; end; {------------------------------------------------------------------------------} procedure TTHDB.ConnectToDatabase; var rParam : rConnectionConfig; begin rParam := GetConnectionConfig; rParam.ModuleName := GetTGUIDString; FDM.InitConnection(rParam); FDM.Connect; end; {------------------------------------------------------------------------------} procedure TThDb.ReStart; begin synchronize( procedure() begin LoadData.WorkOnData; end); end; {------------------------------------------------------------------------------} Procedure TTHDB.WorkOnData; begin if Assigned(FWhenDone) then FWhenDone(FRet); Application.ProcessMessages; end; {------------------------------------------------------------------------------} function TThDb.LoadData : TThDb; var aFiles : TFFilesStatus; begin ... some work ... FRet.FValue:=TValue.From<TFFilesStatus>(aFiles); FRet.FId := FAgs; result:=Self; end; {------------------------------------------------------------------------------} procedure TThDb.Start; begin Resume; end; {------------------------------------------------------------------------------} procedure TThDb.Execute; begin InitializeDatabase; ConnectToDatabase; restart; end; {------------------------------------------------------------------------------} {------------------------------------------------------------------------------} {------------------------------------------------------------------------------} and in the frame constructor I have constructor TFrm.Create(aOwner: TComponent); begin inherited Create(aOwner); FError := TFError.Create; FTh:=TThDb.Create(True); FTh.WithOwner(Self).WhenDone(UpdateGrid); end; and launch the following code ; var i : integer; begin FTh.Start; i:=1; while True do with FTh do if Event.waitfor(0)=wrSignaled then begin Event.ResetEvent; WithAgencies(Format('%0.2d',)).ReStart; inc(i); if i>99 then i:=1; if Terminated then Break; end else Application.ProcessMessages; FTh.Free; As you see I've a loop ( it's nomal in my test), now If I click again on MyForm Create Thread Button from the main form, I create another TForm with a TFrrame in, and the thread connected to the database from the previous form/frame stop working. Is it a normal behaviour or am I missing something ? What I would like of course is that both form with thread in are still running. Thanks for your help Patrick