Jump to content

CoMPi74

Members
 View Profile  See their activity

  • Content Count

    43

  • Joined

  • Last visited

Posts posted by CoMPi74

  1. Posted

    On 10/2/2023 at 9:40 AM, Remy Lebeau said:

    I didn't write TIdHL7 and I'm not familiar with how the HL7 protocol works. I'll have to look into what is going on. I've opened a ticket on Indy's GitHub:

     

    https://github.com/IndySockets/Indy/issues/501

    In fact, I managed to solve the problem by creating a new instance of the TIdHL7 object every time I try to send a HL7 message. In this case, everything works as it should. However, as I wrote earlier, when I tried to send a second message using the same instance of the component (with exactly the same settings), I received the srTimeout message.
    There's clearly something going on, but I can't find it myself. Especially since I use TIdHL7 component in a Windows service, which makes debugging very difficult...

    Anyway, thank you, @Remy Lebeau. 

     

    PS. Is there any smart way to debugging windows services? 

     

     

  2. Posted

    @Remy Lebeau The Indy components have been upgraded a month ago, or so, and now I use Indy ver. 10.6.2.0.  

    Anyway, today's tests show that the app sends the messages every second time (I mean, the first call returns srOK and a valid reply, the second, srTimout and no reply, the third, as the first, srOK and the fourth, as the second, srTimeout, and so on). Looking into code I noticed that when the AsynchronousSend returns srTimeout the method DropClientConnection is called... I suppose that could be the cause of such a behavior...  
    I also tried to use another approach. I changed the CommunicationMode to cmSingleThread, and then I was calling SendMessage and GetReply. Unfortunatelly, without success. GetReply returned srNone evere time. It is quite strange because, as one can read in comments, the state srNone is internally used and (should be) never returned 😕

    Any idea?  

  3. Posted

    Hi there, 

     

    I have a problem with TIdHL7  (Windows 8, Delphi XE4, Indy, ver. 10.6.2.0). Of course, I am trying to solve it by myself, but still without success. Anyway, here is a piece of code which makes me crazy... 

    // stopping IdHL7 before configuration
if IdHL7.Going then IdHL7.Stop;

// setting timeouts and server address 
IdHL7.ReceiveTimeout := 1 * 60 * 1000;
IdHL7.Timeout := 1 * 60 * 1000;
IdHL7.IsListener := False;

IdHL7.Address := SERVER_ADDRESS;
IdHL7.Port := SERVER_PORT;

// starting the connection
IdHL7.Start;
IdHL7.WaitForConnection(10000);

// getting and sending some messages from DB
while not AQuery.EOF do begin
  AMessage := AQuery.FieldByName('MessageToSend').AsString;
  AReturn := IdHL7.SynchronousSend(AMessage, AReply); 		// This is a problematic line ...
  AQuery.Next;
end;

    As one can see I want to send some HL7 messages to SERVER. The server is online and it gets the messages send by SynchronousSend method and responds for them (confirmed). My logs show that the code works as expected but only for the very first call SynchronousSend (the method returns srOK and a valid reply sent byt the remote server).  Unfortunatelly, every next call of SynchronousSend returns srTimouts, even if the result is returned just a few miliseconds after call, what is strange because, as you can see, the timeouts are set for 60 seconds 😕

    What I am doing wrong? What I am missing? 

     

    @Remy Lebeau as everyone knows, You are the undisputed Guru on this topic, so I am sure it is a piece of cake for you. Could you be so nice to help?

     

     

  5. Posted

    6 minutes ago, Uwe Raabe said:

    That would still miss the 

    To achieve that add a message handler like this: 

    
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;


...

procedure TMyTransparentForm.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTTRANSPARENT;
end;

     

    @Uwe Raabe I can not believe it. Is it really so simple? No way 🙂

  6. Posted

    6 minutes ago, KodeZwerg said:

    How about

    - Design a form

    - make it borderless

    - put a Panel on (alClient)

    - put a Timer on

    - create OnShow event to activate timer

    - in Timer event simple call "Close"

     

    from your calling Form

    - create an event that does

      - "Form.Panel.Caption := 'My Text';"

      - "Form.Timer.Interval := 1234;"

     - "Form.Show;"

     

    In theory it does what you wanted, adjust what I forgot to mention.

    @KodeZwerg I did not test it but I am afraid such a form can be activated (gets focus) when clicked. I want to avoid such behaviour.

  7. Posted · Edited by CoMPi74

    Is there a way to create a kind of custom form (or custom form descendant) which would be completely transparent for all mouse and keyboard activities. More precisely, I need a custom form (or other control) to show a message which will disappear after a certain amount of time.

  9. Posted

    On 11/7/2018 at 1:30 PM, Edwin Yip said:

    Try GExperts -> Editor Experts -> Paste String As.

    This is a gem from GExperts. Furthermore - you have 'Copy Raw Strings' which does the opposite.

    Is it possible to modify the templates? Or are they hardcoded? I mean I would like to paste my strings as '%s +', so without 'sLineBreak +' and similar. 

  12. Posted

    7 hours ago, PeterBelow said:

    An event reference you need for SetMethodProp is not a simple method address, it is a record of type TMethod, which holds a pair of pointers, the first (Code) is the address of the method and the second (Data) is the address of the class holding the method. You have to construct the value to pass like this, a typecast as you tried does not quite work for some reason:

      

    
function TMyForm.CreateControl(AClass: TControlClass): TControl;
var
  LEvent: TMethod;
  procedure SetEvent(const aEventName: string; aMethodAdr: Pointer);
  begin
    if IsPublishedProp(Result, aEventName) then begin
      LEvent.Code := aMethodAdr;
      SetMethodProp(Result, aEventName, LEvent);
    end;
  end;
begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  LEvent.Data := self;

  SetEvent('OnClick', @DoOnClick);
  SetEvent('OnKeyDown', @DoOnKeyDown);
  [...]
end;

     

    Nice piece of code. But I can not compile it. I get 'E2036 Variable required' in SetEvent('OnClick', @DoOnClick). To be honest, I experienced similar problem - I was not able to get the address of the event handler method.

  14. Posted

    @Stefan Glienke you are genius, really. Now it works as expected. Thanks a million.

     

    But, by the way, I have another question. Because all these overloads shades the code, then, instead of    

    function TMyForm.CreateControl(AClass: TControlClass): TControl;

  procedure SetEventHandler(const AControl: TControl; const AEventName: string; const AEventHandler: TNotifyEvent); overload;
  begin
    if IsPublishedProp(AControl, AEventName) then SetMethodProp(AControl, AEventName, TMethod(AEventHandler));
  end;

  procedure SetEventHandler(const AControl: TControl; const AEventName: string; const AEventHandler: TKeyEvent); overload;
  begin
    if IsPublishedProp(AControl, AEventName) then SetMethodProp(AControl, AEventName, TMethod(AEventHandler));
  end;

  [...]

begin
  Result := AClass.Create(Self);
  Result.Parent := Self;

  SetEventHandler(Result, 'OnClick', DoOnClick);
  SetEventHandler(Result, 'OnKeyDown', DoOnKeyDown);
  SetEventHandler(Result, 'OnChange', DoOnChange);
  SetEventHandler(Result, 'OnSelect', DoOnSelect);
end;

    I wanted to use something like this 

    function TMyForm.CreateControl(AClass: TControlClass): TControl;
begin
  Result := AClass.Create(Self);
  Result.Parent := Self;

  if IsPublishedProp(Result, 'OnClick') then SetMethodProp(Result, 'OnClick', TMethod(TNotifyEvent(DoOnClick)));
  if IsPublishedProp(Result, 'OnKeyDown') then SetMethodProp(Result, 'OnKeyDown', TMethod(TKeyEvent(DoOnKeyDown)));
  [...]
end;

    But I get 'E2089 Invalid typecast' error. Is not it the same? Any suggestions?

  15. Posted

    4 minutes ago, Peet Terluin said:

    Something like this will work. You need to use a "holder"-control for the eventmethods  you want to assign.

     

    procedure TForm5.btnCreateControlClick(Sender: TObject);
    var
      btn: TButton;
    begin
      btn := TButton.Create(self);
      btn.Caption := 'Click';
      btn.Left := 10;
      btn.Top := 10;
      btn.Parent := self;
      if IsPublishedProp(btn, 'OnClick') then
        SetMethodProp(btn, 'OnClick', GetMethodProp(fProcHolder, 'OnClick'));
    end;

    procedure TForm5.DoOnClick(Sender: TObject);
    begin
      ShowMessage('Hello');
    end;

    procedure TForm5.FormCreate(Sender: TObject);
    begin
      fProcHolder := TEdit.Create(self);
      fProcHolder.OnClick := DoOnClick;
    end;

     

     

    Can' t use GetMethodProp because I prefer all my event handlers to be strict private.

  16. Posted · Edited by CoMPi74

    For implementation, like below,  

    function TMyForm.CreateControl(AClass: TControlClass): TControl;

  procedure SetDefaultEventHandlerIfEventExists2(const AControl: TControl; const AEvent: string; const AHandler: TMethod); 
  begin
    if IsPublishedProp(AControl, AEvent) then SetMethodProp(AControl, AEvent, AHandler);
  end;

begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  
  SetDefaultEventHandlerIfEventExists2(Result, 'OnClick', DoOnClick);
  SetDefaultEventHandlerIfEventExists2(Result, 'OnDblClick', DoOnDblClick);
  [... a few other events ...]
end;

    I got 'E2035 Not enough actual parameters' error... Using '@DoOnClick gives exactly the same error...

  18. Posted · Edited by CoMPi74
    Some corrections and additions

    Hi there,

     

    I'm struggling with the problem for several hours and I can't solve it. 

    function TMyForm.CreateControl(AClass: TControlClass): TControl;

  procedure SetDefaultEventHandlerIfEventExists(const AControl: TControl; const AEvent, AHandler: string); 
  begin
    if IsPublishedProp(AControl, AEvent) then SetMethodProp(AControl, AEvent, GetMethodProp(Self, AHandler));
  end;

begin
  Result := AClass.Create(Self);
  Result.Parent := Self;
  
  SetDefaultEventHandlerIfEventExists(Result, 'OnClick', 'DoOnClick');
  SetDefaultEventHandlerIfEventExists(Result, 'OnDblClick', 'DoOnDblClick');
  [... a few other events ...]
  
  // Since all 'DoOnEvent's are private, local methods of TMyForm I would prefer to use something like below, but I can not manage it to work. What have I missed?
  SetDefaultEventHandlerIfEventExists2(Result, 'OnClick', DoOnClick);
  SetDefaultEventHandlerIfEventExists2(Result, 'OnDblClick', DoOnDblClick);
end;

    Can anyone enlighten me? What have I missed?

     

    PS. I forgot to mention, I use Delphi XE4. Yes, I know, it's a bit old 😉 

  20. Posted

    On 11/5/2019 at 11:14 AM, Stefan Glienke said: 
    
{$APPTYPE CONSOLE}

uses
  Windows;

type
  TFoo = class
    procedure Bar; virtual;
  end;

procedure TFoo.Bar;
begin
  Writeln('broken');
end;

procedure FixedBar(Self: TFoo);
begin
  Writeln('fixed');
end;

var
  f: TFoo;
  p: Pointer;
  n: UINT_PTR;
begin
{$POINTERMATH ON}
  p := @FixedBar;
  WriteProcessMemory(GetCurrentProcess, @PPointer(TFoo)[0], @p, SizeOf(Pointer), n); // 0 is the virtual index of the method to be replaced

  f := TFoo.Create;
  f.Bar;
end.

    The virtual method index can also be found out programmatically.

    @Stefan Glienke Should this also work for 'AfterConstruction'?

  22. Posted

    Actually, I was talking about all files on path defined in Options (Delphi Options -> Library -> Directories -> Library / Browsing path). My fault, I should explain it better. Sorry.
    My problem is that using Ctrl+LMB I often get to a source code I don't want to modify (like VirtualTrees.pas) what, unfortunatelly, happens to me very often. So is there a way to have those files 'protected' against accidental, unintentional modifications?

     

  25. Posted

    1. Is it possible to persistently hide history pane in grep results? I am not sure but I think I remember that some time ago it was possible. Anyway, now (since version 1.3.20) I am not able to achieve that 😕 Deselecting 'View -> History list' checkbox does not work because, from time to time, the pane is showing anyway. Of course, when it happens, the checkbox is checked. I hope I not need to mention that I don't turn on this checkbox myself;)

    2. Almost everytime I use grep for searching some (any?) string in all files in project group (maybe it also happens with other settings but I did not check it) I got 'Out of memory' error. The situation happens regardless of whether there is, or not, free memory. Followed grep options are checked: Whole word, Search form files, All file in project group, Parse map file and all options in Delphi Code Content Types and Delphi Code Sections.

     

    Can anyone confirm these problems?

     

    PS. Delphi XE4, GExperts 1.3.21

×