Recent

Author Topic: Convert Errors Delphi -> Lazarus  (Read 2816 times)

Thaddy

  • Hero Member
  • *****
  • Posts: 8927
Re: Convert Errors Delphi -> Lazarus
« Reply #30 on: August 23, 2019, 03:39:02 pm »
2.  The SHA256 coding doesn't work. Below code works fine in Delphi:
Code: Pascal  [Select]
  1. var
  2.   newPW : String;
  3. begin
  4.   newPW := ThashSHA2.GetHashString(newPW), SHA256);
  5. end;
  6.  
Of course that does not work, not even in Delphi, it should throw a syntax error.' )' expected ';' found
« Last Edit: August 23, 2019, 03:41:38 pm by Thaddy »
Most people that want to use threading should learn to patch their jeans first: use a needle.

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #31 on: August 23, 2019, 03:51:21 pm »
Yeah okay, it was a cut out. Originally it has been a
Code: Pascal  [Select]
  1.   showmessage(ThashSHA2.GetHashString(newPW), SHA256);
  2.  
to control the output only during testing. (Copy/Paste error only here in forum)
The path is the destination but you should never lose sight of the destination on the way.

Xor-el

  • Sr. Member
  • ****
  • Posts: 371
Re: Convert Errors Delphi -> Lazarus
« Reply #32 on: August 23, 2019, 04:07:12 pm »
Yeah okay, it was a cut out. Originally it has been a
Code: Pascal  [Select]
  1.   showmessage(ThashSHA2.GetHashString(newPW), SHA256);
  2.  
to control the output only during testing. (Copy/Paste error only here in forum)

ShowMessage does not have an overload accepting 2 parameters so your code is still wrong.

I guess this is what you meant.

Code: Pascal  [Select]
  1. showmessage(THashSHA2.GetHashString(newPW, TSHA2Version.SHA256));
  2.  

Well, in simple terms, there is no direct alternative to that function THashSHA2 inbuilt in FPC but there are external alternatives available that can be installed from OPM which includes HashLib4Pascal and DCPCrypt.

Using HashLib4Pascal, this code below should work for you.

Code: Pascal  [Select]
  1. ShowMessage(THashFactory.TCrypto.CreateSHA2_256().ComputeString(newPW, TEncoding.UTF8).ToString());
  2.  

Update
Forgot to indicate originally that you need to add HlpHashFactory to the uses clause of your unit.
« Last Edit: August 26, 2019, 09:31:42 am by Xor-el »

PascalDragon

  • Hero Member
  • *****
  • Posts: 626
  • Compiler Developer
Re: Convert Errors Delphi -> Lazarus
« Reply #33 on: August 23, 2019, 04:12:20 pm »
As marcov already wrote the -FN option was only added in 3.1.1 and is thus only available there (I should really add an entry for the 3.2 features page...).
I've now added it to FPC New Features 3.2 as it should be. :D

JuhaManninen

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 3633
  • I like bugs.
Re: Convert Errors Delphi -> Lazarus
« Reply #34 on: August 23, 2019, 05:31:05 pm »
3. Ini doen't read as Unicode (again the Problem with the umlauts):
Code: Pascal  [Select]
  1. Delay.Text          := Ini.ReadString ('Install' , 'Delay'               , '15');
It is read correctly if the file contains Unicode text with UTF-8 encoding.
You should read this page to understand Unicode in Lazarus:
 https://wiki.lazarus.freepascal.org/Unicode_Support_in_Lazarus
You only seldom need to call Windows API. Most often you can use the cross-platform functions provided by FPC and Lazarus libraries.
Although this forum section is for FPC, you are working with a Lazarus application now, right?
« Last Edit: August 23, 2019, 05:33:21 pm by JuhaManninen »

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #35 on: August 26, 2019, 08:33:20 am »
@Juha: I've found the problem to the ini-file (File was unicode), saved as utf8 and now the correct path is read.


Yes, thought this is right place but change section if I am wrong here.
« Last Edit: August 26, 2019, 11:01:47 am by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #36 on: August 26, 2019, 09:20:30 am »
Hash now works fine, found which i have to add to uses additional. Thanks to Xor-el
« Last Edit: August 26, 2019, 09:24:24 am by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #37 on: August 26, 2019, 11:31:47 am »
I do not get out of the umlaut problem -.-

I call a function:
Code: Pascal  [Select]
  1. OpenExcel(ExcelE.Text, FXLApp);     //ExcelE.Text = Path to the file. Path includes umlauts
  2.  

The function:
Code: Pascal  [Select]
  1. function OpenExcel(AFileName : string; var AXLApp : OleVariant):boolean;
  2. begin
  3.   Result := false;
  4.   // Wenn noch offen, dann schließen..
  5.   CloseExcel(AXLApp);
  6.  
  7.   // Create Excel-OLE Object
  8.   try
  9.     AXLApp := CreateOleObject('Excel.Application');
  10.     Result := True;
  11.   except
  12.     On E:Exception do
  13.     begin
  14.       // Log Exception, wenn kein Excel installiert!
  15.       ShowMessage('Error INIT : ' + E.Message);
  16.     end;
  17.   end;
  18.  
  19.   if Result then begin
  20.     try
  21.       AXLApp.Visible := False;
  22.       AXLApp.Workbooks.OpenXML(AFileName);  //Get Error here (can't find '')
  23.     except
  24.       On E:Exception do
  25.       begin
  26.         // Log Exception, wenn Datei nicht vorhanden!
  27.         ShowMessage('Error OPEN : ' + E.Message);
  28.         // Excel wieder schließen, da nicht gebraucht
  29.         CloseExcel(AXLApp);
  30.       end;
  31.     end;
  32.   end;
  33. end;  
  34.  

If i change the path to some without umlaut, it works fine but i can't change the path (networkpath);
And if i use Unicodestring() i get an exception (SIGSEGV).
« Last Edit: August 26, 2019, 11:44:50 am by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 7446
Re: Convert Errors Delphi -> Lazarus
« Reply #38 on: August 26, 2019, 12:02:43 pm »
Try making the parameter of the procedure "widestring"

wp

  • Hero Member
  • *****
  • Posts: 6233
Re: Convert Errors Delphi -> Lazarus
« Reply #39 on: August 26, 2019, 12:02:53 pm »
This is how it works for me:
Code: Pascal  [Select]
  1. var
  2.   ws: WideString;
  3. ...
  4.   ws := UTF8Decode(AFileName);
  5.   AXLApp.Workbooks.OpenXML(ws);

AFileName comes from your Lazarus program and, therefore, is a UTF8-encoded AnsiString. Excel requires a WideString. It certainly can be done otherwise, but as an old-fashioned guy I prefer the direct conversion with UTF8Decode() (direct assignment "ws := AFileName" works, too, at least in fpc 3.0+). Interestingly, putting this into the OpenXML call directly (without the intermediate variable) does not work - strange...
« Last Edit: August 26, 2019, 12:08:05 pm by wp »
Lazarus trunk / fpc 3.0.4 / all 32-bit on Win-10

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #40 on: August 26, 2019, 12:30:14 pm »
Why didn't i try widestring, all other things i have tried  :-[ yes tis works fine now.
The path is the destination but you should never lose sight of the destination on the way.

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 7446
Re: Convert Errors Delphi -> Lazarus
« Reply #41 on: August 26, 2019, 12:56:31 pm »
Interestingly, putting this into the OpenXML call directly (without the intermediate variable) does not work - strange...

Probably the argument is a variant. So it is the Lazarus utf8 style 1-byte string to variant conversion that is the problem. But if you type the whole COM related procedure in widestrings and pass your lazarus strings to it, it gets autoconverted and works quite fine

See it as a kind of boxing problem. If you put a type X into a variant that supports X, you get a variant with X inside.

For the Lazarus side, X is ansistring, while for the COM kind it must be widestring.

Why unicodestring goes wrong I don't know. Maybe it prefers ansistring over widestring in the "to-variant" conversion.
« Last Edit: August 26, 2019, 12:59:49 pm by marcov »

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #42 on: September 05, 2019, 10:33:23 am »
Next Step  :o

I get an Error by using:
Code: Pascal  [Select]
  1.   private
  2.     { Private-Deklarationen }
  3.     Watch: TDirectoryWatch;  
  4.  
  5. procedure TTools.NewLog(Path : widestring);
  6. begin
  7.   if sFileAction = 'Create' then
  8.   begin
  9.     if SysUtils.ForceDirectories(Path) then
  10.       begin
  11.         LogL.Caption       := 'Auf Log Datei warten...';
  12.         LogL.Show;
  13.         Programs.Enabled   := False;
  14.         Data.Enabled       := False;
  15.         TxTLogs.Enabled    := False;
  16.         Watch              := TDirectoryWatch.Create; //Fails here!
  17.         Watch.WatchOptions := [woFileName, woDirName, woAttributes, woSize, woLastWrite, woLastAccess, woCreation, woSecurity];
  18.         Watch.WatchActions := [waAdded];
  19.         Watch.Directory    := Path;
  20.         Watch.OnNotify     := OnNotify;
  21.         Watch.Start;
  22.       end else
  23.       begin
  24.         MessageDlg('Verzeichnis konnte nicht erstellt werden', TMsgDlgType.mtError, [mbOK], 0)
  25.       end;
  26.   end else
  27.   begin
  28.     if sFileAction = 'Edited' then
  29.     begin
  30.       FileChange     := ReportFileTimes(Path);
  31.       olddate        := FileChange;
  32.       Timer3.Enabled := True;
  33.     end;
  34.   end;
  35. end;  
  36.  

TDirectoryWatch here:
Code: Pascal  [Select]
  1. (*
  2.  * This software is distributed under BSD license.
  3.  *
  4.  * Copyright (c) 2009 Iztok Kacin, Cromis (iztok.kacin@gmail.com).
  5.  * All rights reserved.
  6.  *
  7.  * Redistribution and use in source and binary forms, with or without modification,
  8.  * are permitted provided that the following conditions are met:
  9.  *
  10.  * - Redistributions of source code must retain the above copyright notice, this
  11.  *   list of conditions and the following disclaimer.
  12.  * - Redistributions in binary form must reproduce the above copyright notice, this
  13.  *   list of conditions and the following disclaimer in the documentation and/or
  14.  *   other materials provided with the distribution.
  15.  * - Neither the name of the Iztok Kacin nor the names of its contributors may be
  16.  *   used to endorse or promote products derived from this software without specific
  17.  *   prior written permission.
  18.  *
  19.  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
  20.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  21.  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  22.  * IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  23.  * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  24.  * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  25.  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  26.  * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  27.  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  28.  * OF THE POSSIBILITY OF SUCH DAMAGE.
  29.  *
  30.  * NOTICE OF CODE ORIGIN
  31.  *
  32.  * This code was derived from the original code of author "Gleb Yourchenko"
  33.  * The original code "FnugryDirWatch" can still be found at Torry Components
  34.  * The URL is: http://www.torry.net/pages.php?id=252
  35.  *
  36.  * The code was taken as a starting point and then mainly written from scratch
  37.  * keeping some of the healthy code parts. So I am not in any way an author of
  38.  * the original idea. But I am the author of all the changes and new code parts.
  39.  *
  40.  * ============================================================================
  41.  * 12/10/2009 (1.0.0)
  42.  *  - Initial code rewrite from "FnugryDirWatch"
  43.  * 16/01/2010 (1.0.1)
  44.  *  - Refactored the main watch loop
  45.  * ============================================================================
  46. *)
  47.  
  48. unit DirectoryWatch;
  49.  
  50. {$MODE Delphi}
  51. {$WARN 5057 off : Local variable "$1" does not seem to be initialized}
  52. interface
  53.  
  54. uses
  55.    Windows, LCLIntf, LCLType, LMessages, SysUtils, FileUtil, Classes, Messages,
  56.    SyncObjs, RDCWProcessMonitor, RDCWDirMonitor;
  57.  
  58. const
  59.   FILE_NOTIFY_CHANGE_FILE_NAME   = $00000001;
  60.   FILE_NOTIFY_CHANGE_DIR_NAME    = $00000002;
  61.   FILE_NOTIFY_CHANGE_ATTRIBUTES  = $00000004;
  62.   FILE_NOTIFY_CHANGE_SIZE        = $00000008;
  63.   FILE_NOTIFY_CHANGE_LAST_WRITE  = $00000010;
  64.   FILE_NOTIFY_CHANGE_LAST_ACCESS = $00000020;
  65.   FILE_NOTIFY_CHANGE_CREATION    = $00000040;
  66.   FILE_NOTIFY_CHANGE_SECURITY    = $00000100;
  67.  
  68. const
  69.   cShutdownTimeout = 3000;
  70.  
  71. type
  72.   // the filters that control when the watch is triggered
  73.   TWatchOption = (woFileName, woDirName, woAttributes, woSize, woLastWrite,
  74.                   woLastAccess, woCreation, woSecurity);
  75.   TWatchOptions = set of TWatchOption;
  76.  
  77.   // the actions that are the result of the watch being triggered
  78.   TWatchAction = (waAdded, waRemoved, waModified, waRenamedOld, waRenamedNew);
  79.   TWatchActions = set of TWatchAction;
  80.  
  81.   TFileChangeNotifyEvent = procedure(const Sender: TObject;
  82.                                      const Action: TWatchAction;
  83.                                      const FileName: widestring
  84.                                      ) of object;
  85.  
  86.   TDirectoryWatch = class
  87.   private
  88.     FWatchOptions : TWatchOptions;
  89.     FWatchActions : TWatchActions;
  90.     FWatchSubTree : Boolean;
  91.     FWatchThread  : TThread;
  92.     FWndHandle    : HWND;
  93.     FDirectory    : widestring;
  94.     FAbortEvent   : Cardinal;
  95.     FOnChange     : TNotifyEvent;
  96.     FOnNotify     : TFileChangeNotifyEvent;
  97.     procedure WatchWndProc(var Msg: TMessage);
  98.     procedure SetDirectory(const Value: widestring);
  99.     procedure SetWatchOptions(const Value: TWatchOptions);
  100.     procedure SetWatchActions(const Value: TWatchActions);
  101.     procedure SetWatchSubTree(const Value: Boolean);
  102.     procedure DeallocateHWnd(Wnd: HWND);
  103.     function MakeFilter: Integer;
  104.   protected
  105.     procedure Change; virtual;
  106.     procedure AllocWatchThread;
  107.     procedure ReleaseWatchThread;
  108.     procedure RestartWatchThread;
  109.     procedure Notify(const Action: Integer;
  110.                      const FileName: widestring
  111.                      ); virtual;
  112.   public
  113.     constructor Create;
  114.     destructor Destroy; override;
  115.     procedure Start;
  116.     procedure Stop;
  117.     function Running: Boolean;
  118.     property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
  119.     property WatchOptions: TWatchOptions read FWatchOptions write SetWatchOptions;
  120.     property WatchActions: TWatchActions read FWatchActions write SetWatchActions;
  121.     property Directory: widestring read FDirectory write SetDirectory;
  122.     // notification properties. Notify about internal and exernal changes
  123.     property OnNotify: TFileChangeNotifyEvent read FOnNotify write FOnNotify;
  124.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  125.   end;
  126.  
  127. implementation
  128.  
  129. type
  130.   PFILE_NOTIFY_INFORMATION = ^TFILE_NOTIFY_INFORMATION;
  131.   TFILE_NOTIFY_INFORMATION = record
  132.     NextEntryOffset : Cardinal;
  133.     Action          : Cardinal;
  134.     FileNameLength  : Cardinal;
  135.     FileName        : array[0..MAX_PATH - 1] of WideChar;
  136.   end;
  137.  
  138. const
  139.   WM_DIRWATCH_ERROR    = WM_USER + 137;
  140.   WM_DIRWATCH_NOTIFY   = WM_USER + 138;
  141.  
  142.   FILE_LIST_DIRECTORY  = $0001;
  143.  
  144. const
  145.   // error messages
  146.   cErrorInWatchThread = 'Error "%s" in watch thread. Error code: %d';
  147.   cErrorCreateWatchError = 'Error trying to create file handle for "%s". Error code: %d';
  148.  
  149. const
  150.   IO_BUFFER_LEN = 32 * SizeOf(TFILE_NOTIFY_INFORMATION);
  151.  
  152. type
  153.   TDirWatchThread = class(TThread)
  154.   private
  155.      FWatchSubTree : Boolean;
  156.      FAbortEvent   : Cardinal;
  157.      FChangeEvent  : Cardinal;
  158.      FWndHandle    : Cardinal;
  159.      FDirHandle    : Cardinal;
  160.      FDirectory    : widestring;
  161.      FIOResult     : Pointer;
  162.      FFilter       : Integer;
  163.   protected
  164.      procedure Execute; override;
  165.   public
  166.      constructor Create(const Directory: widestring;
  167.                         const WndHandle: Cardinal;
  168.                         const AbortEvent: Cardinal;
  169.                         const TypeFilter: Cardinal;
  170.                         const aWatchSubTree: Boolean);
  171.      destructor Destroy; override;
  172.   end;
  173.  
  174. procedure TDirWatchThread.Execute;
  175. var
  176.   NotifyData: PFILE_NOTIFY_INFORMATION;
  177.   Events: array[0..1] of THandle;
  178.   WaitResult: DWORD;
  179.   NextEntry: Integer;
  180.   ErrorMsg: PWideChar;
  181.   FileName: PWideChar;
  182.   Overlap: TOverlapped;
  183.   ResSize: Cardinal;
  184. begin
  185.   FillChar(Overlap, SizeOf(TOverlapped), 0);
  186.   Overlap.hEvent := FChangeEvent;
  187.  
  188.   // set the array of events
  189.   Events[0] := FChangeEvent;
  190.   Events[1] := FAbortEvent;
  191.  
  192.   while not Terminated do
  193.   try
  194.     if ReadDirectoryChangesW(FDirHandle, FIOResult, IO_BUFFER_LEN, FWatchSubtree, FFilter, @ResSize, @Overlap, nil) then
  195.     begin
  196.       WaitResult := WaitForMultipleObjects(2, @Events[0], FALSE, INFINITE);
  197.  
  198.       // check if we have terminated the thread
  199.       if WaitResult <> WAIT_OBJECT_0 then
  200.       begin
  201.         Terminate;
  202.         Exit;
  203.       end;
  204.      
  205.       if WaitResult = WAIT_OBJECT_0 then
  206.       begin
  207.         NotifyData := FIOResult;
  208.  
  209.         repeat
  210.           NextEntry := NotifyData^.NextEntryOffset;
  211.  
  212.           // get memory for filename and fill it with data
  213.           GetMem(FileName, NotifyData^.FileNameLength + 2);
  214.           Move(NotifyData^.FileName, Pointer(FileName)^, NotifyData^.FileNameLength);
  215.           PWord(Cardinal(FileName) + NotifyData^.FileNameLength)^ := 0;
  216.  
  217.           // send the message about the filename information and advance to the next entry
  218.           PostMessage(FWndHandle, WM_DIRWATCH_NOTIFY, NotifyData^.Action, LParam(FileName));
  219.           Inc(NotifyData, NextEntry);
  220.         until (NextEntry = 0);
  221.       end;
  222.     end;
  223.   except
  224.     on E :Exception do
  225.     begin
  226.       GetMem(ErrorMsg, Length(E.Message) + 2);
  227.       Move(E.Message, Pointer(ErrorMsg)^, Length(E.Message));
  228.       PWord(Cardinal(ErrorMsg) + Cardinal(Length(E.Message)))^ := 0;
  229.       PostMessage(FWndHandle, WM_DIRWATCH_ERROR, GetLastError, LPARAM(ErrorMsg));
  230.     end;
  231.   end;
  232. end;
  233.  
  234. constructor TDirWatchThread.Create(const Directory: widestring;
  235.                                    const WndHandle: Cardinal;
  236.                                    const AbortEvent: Cardinal;
  237.                                    const TypeFilter: Cardinal;
  238.                                    const aWatchSubTree: Boolean);
  239. begin
  240.    //
  241.    // Retrieve proc pointer, open directory to
  242.    // watch and allocate buffer for notification data.
  243.    // (note, it is done before calling inherited
  244.    // create (that calls BeginThread) so any exception
  245.    // will be still raised in caller's thread)
  246.    //
  247.    FDirHandle := CreateFile(PChar(Directory),
  248.                             FILE_LIST_DIRECTORY,
  249.                             FILE_SHARE_READ OR
  250.                             FILE_SHARE_DELETE OR
  251.                             FILE_SHARE_WRITE,
  252.                             nil, OPEN_EXISTING,
  253.                             FILE_FLAG_BACKUP_SEMANTICS OR
  254.                             FILE_FLAG_OVERLAPPED,
  255.                             0);
  256.  
  257.    //if FDirHandle = INVALID_HANDLE_VALUE then
  258.    //begin
  259.    //  raise Exception.CreateFmt(cErrorCreateWatchError, [Directory, GetLastError]);
  260.    //end;
  261.  
  262.    FChangeEvent := CreateEvent(nil, FALSE, FALSE, nil);
  263.    FAbortEvent := AbortEvent;
  264.  
  265.    // allocate the buffer memory
  266.    GetMem(FIOResult, IO_BUFFER_LEN);
  267.  
  268.    FWatchSubTree := aWatchSubtree;
  269.    FWndHandle := WndHandle;
  270.    FDirectory := Directory;
  271.    FFilter := TypeFilter;
  272.  
  273.    // make sure we free the thread
  274.    FreeOnTerminate := True;
  275.  
  276.    inherited Create(False);
  277. end;
  278.  
  279.  
  280. destructor TDirWatchThread.Destroy;
  281. begin
  282.    //if FDirHandle <> INVALID_HANDLE_VALUE  then
  283.    //  FileClose(FDirHandle); { *Konvertiert von CloseHandle* }
  284.    if Assigned(FIOResult) then
  285.      FreeMem(FIOResult);
  286.  
  287.    inherited Destroy;
  288. end;
  289.  
  290. { TFnugryDirWatch }
  291.  
  292. procedure TDirectoryWatch.AllocWatchThread;
  293. begin
  294.   if FWatchThread = nil then
  295.   begin
  296.     FAbortEvent := CreateEvent(nil, FALSE, FALSE, nil);
  297.     FWatchThread := TDirWatchThread.Create(Directory,
  298.                                            FWndHandle,
  299.                                            FAbortEvent,
  300.                                            MakeFilter,
  301.                                            WatchSubtree);
  302.   end;
  303. end;
  304.  
  305. procedure TDirectoryWatch.ReleaseWatchThread;
  306. var
  307.   AResult: Cardinal;
  308. begin
  309.   if FWatchThread <> nil then
  310.   begin
  311.     // set and close event
  312.     SetEvent(FAbortEvent);
  313.     FileClose(FAbortEvent); { *Konvertiert von CloseHandle* }
  314.  
  315.     // wait and block until thread is finished
  316.     AResult := WaitForSingleObject(FWatchThread.Handle, cShutdownTimeout);
  317.  
  318.     // check if we timed out
  319.     if AResult = WAIT_TIMEOUT then
  320.       TerminateThread(FWatchThread.Handle, 0);
  321.  
  322.     FWatchThread := nil;
  323.   end;
  324.  
  325. end;
  326.  
  327. procedure TDirectoryWatch.RestartWatchThread;
  328. begin
  329.   Stop;
  330.   Start;
  331. end;
  332.  
  333. function TDirectoryWatch.Running: Boolean;
  334. begin
  335.   Result := FWatchThread <> nil;
  336. end;
  337.  
  338. procedure TDirectoryWatch.DeallocateHWnd(Wnd: HWND);
  339. var
  340.   Instance: Pointer;
  341. begin
  342.   Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  343.  
  344.   if Instance <> @DefWindowProc then
  345.   begin
  346.     { make sure we restore the default
  347.       windows procedure before freeing memory }
  348.     SetWindowLong(Wnd, GWL_WNDPROC, Longint(@DefWindowProc));
  349.     FreeObjectInstance(Instance);
  350.   end;
  351.  
  352.   DestroyWindow(Wnd);
  353. end;
  354.  
  355. destructor TDirectoryWatch.Destroy;
  356. begin
  357.   Stop;
  358.   DeallocateHWnd(FWndHandle);
  359.  
  360.   inherited Destroy;
  361. end;
  362.  
  363. constructor TDirectoryWatch.Create;
  364. begin
  365.    FWndHandle := AllocateHWnd(WatchWndProc);
  366.    FWatchSubtree := True;
  367.  
  368.    // construct the default watch actions and options
  369.    FWatchActions := [waAdded]; //, waRemoved, waModified, waRenamedOld, waRenamedNew];
  370.    FWatchOptions := [woFileName, woDirName, woAttributes, woSize, woLastWrite,
  371.                      woLastAccess, woCreation, woSecurity];
  372. end;
  373.  
  374.  
  375.  
  376. procedure TDirectoryWatch.SetWatchActions(const Value: TWatchActions);
  377. begin
  378.   if FWatchActions <> Value then
  379.   begin
  380.     FWatchActions := Value;
  381.  
  382.     if Running then
  383.       RestartWatchThread;
  384.  
  385.     Change;
  386.   end;
  387. end;
  388.  
  389. procedure TDirectoryWatch.SetWatchOptions(const Value: TWatchOptions);
  390. begin
  391.   if FWatchOptions <> Value then
  392.   begin
  393.     FWatchOptions := Value;
  394.  
  395.     if Running then
  396.       RestartWatchThread;
  397.  
  398.     Change;
  399.   end;
  400. end;
  401.  
  402. procedure TDirectoryWatch.WatchWndProc(var Msg :TMessage);
  403. var
  404.   ErrorCode: Cardinal;
  405.   ErrorMessage: string;
  406. begin
  407.    case Msg.msg of
  408.      WM_DIRWATCH_NOTIFY:
  409.      //
  410.      // Retrieve notify data and forward
  411.      // the event to TDirectoryWatch's notify
  412.      // handler. Free filename string (allocated
  413.      // in WatchThread's notify handler.)
  414.      //
  415.      begin
  416.         try
  417.            Notify(Msg.wParam, WideCharToString(PWideChar(Msg.lParam)));
  418.         finally
  419.           if Msg.lParam <> 0 then
  420.             FreeMem(Pointer(Msg.lParam));
  421.         end;
  422.      end;
  423.  
  424.      WM_DIRWATCH_ERROR:
  425.      //
  426.      // Disable dir watch and re-raise
  427.      // exception on error
  428.      //
  429.      begin
  430.         try
  431.           ErrorMessage := WideCharToString(PWideChar(Msg.lParam));
  432.           ErrorCode := Msg.WParam;
  433.           Stop;
  434.  
  435.           raise Exception.CreateFmt(cErrorInWatchThread, [ErrorMessage, ErrorCode]);
  436.         finally
  437.           if Msg.lParam <> 0 then
  438.             FreeMem(Pointer(Msg.lParam));
  439.         end;
  440.      end;
  441.      //
  442.      // pass all other messages down the line
  443.      //
  444.      else
  445.      begin
  446.        Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  447.        Exit;
  448.      end;
  449.    end;
  450. end;
  451.  
  452. function TDirectoryWatch.MakeFilter: Integer;
  453. const
  454.   FilterFlags: array [TWatchOption] of Integer = (FILE_NOTIFY_CHANGE_FILE_NAME,
  455.                                                   FILE_NOTIFY_CHANGE_DIR_NAME,
  456.                                                   FILE_NOTIFY_CHANGE_ATTRIBUTES,
  457.                                                   FILE_NOTIFY_CHANGE_SIZE,
  458.                                                   FILE_NOTIFY_CHANGE_LAST_WRITE,
  459.                                                   FILE_NOTIFY_CHANGE_LAST_ACCESS,
  460.                                                   FILE_NOTIFY_CHANGE_CREATION,
  461.                                                   FILE_NOTIFY_CHANGE_SECURITY);
  462. var
  463.   Flag: TWatchOption;
  464. begin
  465.   Result := 0;
  466.  
  467.   for Flag in FWatchOptions do
  468.     Result := Result or FilterFlags[Flag];
  469. end;
  470.  
  471. procedure TDirectoryWatch.SetWatchSubTree(const Value :Boolean);
  472. begin
  473.   if Value <> FWatchSubtree then
  474.   begin
  475.     FWatchSubtree := Value;
  476.  
  477.     if Running then
  478.       RestartWatchThread;
  479.  
  480.     Change;
  481.   end;
  482. end;
  483.  
  484.  
  485. procedure TDirectoryWatch.Start;
  486. begin
  487.   if FDirectory = '' then
  488.     raise Exception.Create('Please specify a directory to watch');
  489.  
  490.   if not Running then
  491.   begin
  492.     AllocWatchThread;
  493.     Change;
  494.   end;
  495. end;
  496.  
  497. procedure TDirectoryWatch.Stop;
  498. begin
  499.   if Running then
  500.   begin
  501.     ReleaseWatchThread;
  502.     Change;
  503.   end;
  504. end;
  505.  
  506. procedure TDirectoryWatch.SetDirectory(const Value: widestring);
  507. begin
  508.   if StrIComp(PChar(Trim(Value)), PChar(FDirectory)) <> 0 then
  509.   begin
  510.     FDirectory := Trim(Value);
  511.  
  512.     if Running then
  513.     begin
  514.       RestartWatchThread;
  515.     end;
  516.  
  517.     Change;
  518.   end;
  519. end;
  520.  
  521. procedure TDirectoryWatch.Change;
  522. begin
  523.   if Assigned(FOnChange) then
  524.   begin
  525.     FOnChange(Self);
  526.   end;
  527. end;
  528.  
  529. procedure TDirectoryWatch.Notify(const Action: Integer; const FileName: widestring);
  530. begin
  531.   if Assigned(FOnNotify) then
  532.     if TWatchAction(Action - 1) in FWatchActions then
  533.       FOnNotify(Self, TWatchAction(Action - 1), FileName);
  534. end;
  535.  
  536. end.
  537.  
« Last Edit: September 05, 2019, 10:42:26 am by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

wp

  • Hero Member
  • *****
  • Posts: 6233
Re: Convert Errors Delphi -> Lazarus
« Reply #43 on: September 05, 2019, 11:00:21 am »
I get an Error by using:
"An Error" is a very "clear" statement... Always tell the error message or post a screenshot.
Lazarus trunk / fpc 3.0.4 / all 32-bit on Win-10

Moombas

  • New Member
  • *
  • Posts: 24
Re: Convert Errors Delphi -> Lazarus
« Reply #44 on: September 05, 2019, 11:03:47 am »
Screenshot attached but i don't think that this helps much. Because of that i haven't attached it before. And only found this:

Quote
Runtime error 211 program not executable by runtime system
This article explains why a 211 error occurs when trying to run a program that was ported from another server.

Problem:
When I was trying to run a program that was ported from another server, a 211 error occurs. Specifically, the message received was a load error 211 pc=0, call=1, seg=20 211 program not executable by runtime system. Why is this happening?

Resolution:
The reason this error is occurring is because the program is 64 bit and was ported over from another system to one whose Server Express product and/or hardware is 32 bit only. This problem can occur on AIX systems with Server Express prior to version 4.0SP2. The 32 and 64 bit versions for AIX were separate products until version 4.0SP2 was released. If a program is compiled with the 64 bit product on an AIX system and run with COBDIR, PATH, and LIBPATH set for the 32 bit product, error 211 will occur. The same is true for 64 bit code ported to any AIX 4.3.3 system. That version of AIX is 32 bit only. A few Sun Solaris installations run on 32 bit-only SPARC hardware. Load error 211 will occur if a 64 bit program is ported from another Solaris/SPARC system. Object Cobol Developer Suite is 32 bit only on all platforms and cannot run 64 bit programs.

Incident Number: 2146320

Old KB# 14397
« Last Edit: September 05, 2019, 11:05:19 am by Moombas »
The path is the destination but you should never lose sight of the destination on the way.