Recent

Author Topic: Lazarus problem after new Version  (Read 795 times)

Moombas

  • New Member
  • *
  • Posts: 31
Lazarus problem after new Version
« on: January 27, 2021, 10:52:51 am »
Hi all,

because of new PC-Installation i use now the actual Lazarus Version but get an error when trying to compile a project:

fpg_oledragdrop.pas(113,23) Error: No matching implementation for interface method "SetData(const tagFORMATETC;var TagSTGMEDIUM;LongBool):LongInt; StdCall;" found

I found a change here: https://github.com/graemeg/fpGUI/blob/cbe4f70f2546252fbad0e6a380ce7b1f9e8439a3/src/corelib/gdi/fpg_oledragdrop.pas
But if i apply it, i get different errors in same file:
fpg_oledragdrop.pas(193,15) Error: Identifier not found "MIME_TEXT_PLAIN"
fpg_oledragdrop.pas(199,15) Error: Identifier not found "MIME_TEXT_URI_LIST"
fpg_oledragdrop.pas(201,15) Error: Identifier not found "MIME_TEXT_HTML"
...
fpg_oledragdrop.pas(655,16) Warning: use of NEW or DISPOSE for untyped pointers is meaningless
fpg_oledragdrop.pas(746,28) Error: Identifier not found "TfpgNativeWindow"

I read something about that there changed something but how to fix this.  Even i don't use drag and drop, but i think it's a general one!?
I really need help here, need to compile the program :(

I mixed now both version up, hopefully it doesn't take side effects there... (not working parts of "new" version replaced with working parts of old version.

But now i got a problem in my compiled program, that it's not finding files -.-

Does anyone know why following is only creating the "root" folder but not copy any files/dirs anymore:

Code: Pascal  [Select][+][-]
  1. function TTools.CopyDir(SourceDirectory: WideString; DestinationDirectory: WideString): boolean;
  2. var
  3.   SHFileOpStruct: TSHFileOpStructW;
  4.   SourceBuffer, DestinationBuffer: array[0..255] of char;
  5.   res: integer;
  6. begin
  7.   try
  8.     if not SysUtils.DirectoryExists(SourceDirectory) then
  9.     begin
  10.       Result := False;
  11.       exit;
  12.     end;
  13.     Fillchar(SHFileOpStruct, sizeof(SHFileOpStruct), 0);
  14.     FillChar(SourceBuffer, sizeof(SourceBuffer), 0);
  15.     FillChar(DestinationBuffer, sizeof(DestinationBuffer), 0);
  16.     StrPCopy(SourceBuffer, String(SourceDirectory));
  17.     StrPCopy(DestinationBuffer, String(DestinationDirectory));
  18.     with SHFileOpStruct do
  19.     begin
  20.       Wnd := 0;
  21.       wFunc := FO_COPY;
  22.       pFrom := @SourceBuffer;
  23.       pTo := @DestinationBuffer;
  24.       fFlags := FOF_ALLOWUNDO;
  25.       hNameMappings := nil;
  26.       lpszProgressTitle := nil;
  27.  
  28.       fFlags := fFlags or FOF_NOCONFIRMATION;
  29.       fFlags := fFlags or FOF_SILENT;
  30.       fFlags := fFlags or FOF_SIMPLEPROGRESS;
  31.       fFlags := fFlags or FOF_NOCONFIRMMKDIR;
  32.     end;
  33.     res := SHFileOperationW(@SHFileOpStruct);
  34.     Result := (res = 0);
  35.  
  36.     if not Result then
  37.     begin
  38.       ShowMessage(SysErrorMessage(GetLastError));
  39.     end;
  40.   except
  41.     Result := False;
  42.   end;
  43. end;
« Last Edit: January 29, 2021, 03:33:23 pm by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

ASerge

  • Hero Member
  • *****
  • Posts: 1737
Re: Lazarus problem after new Version
« Reply #1 on: January 27, 2021, 07:10:13 pm »
Does anyone know why following is only creating the "root" folder but not copy any files/dirs anymore:
First, Char in FPC is AnsiChar, but the structure assumes WideChar.
Second, the pFrom and pTo parameters must end with a double zero, as stated in the documentation.
Third, it is useless to call GetLastError, this is also mentioned in the documentation.
Fourth, the "try except end" construction without error handling is a bad design. You may miss an important error. If you don't process something, leave it for the calling code.
Code: Pascal  [Select][+][-]
  1. uses ShellApi;
  2.  
  3. function CopyDir(const SourceDirectory, DestinationDirectory: string): Boolean;
  4. var
  5.   SHFileOpStruct: TSHFileOpStructW;
  6.   SourceBuffer, DestinationBuffer: UnicodeString;
  7. begin
  8.   if not SysUtils.DirectoryExists(SourceDirectory) then
  9.     Exit(False);
  10.   FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), 0);
  11.   SourceBuffer := UTF8Decode(SourceDirectory) + #0#0; // or can be only have one #0, given a string implements
  12.   DestinationBuffer := UTF8Decode(DestinationDirectory) + #0#0;
  13.   with SHFileOpStruct do
  14.   begin
  15.     wFunc := FO_COPY;
  16.     pFrom := Pointer(SourceBuffer);
  17.     pTo := Pointer(DestinationBuffer);
  18.     fFlags := FOF_ALLOWUNDO;
  19.     fFlags := fFlags or FOF_NOCONFIRMATION;
  20.     fFlags := fFlags or FOF_SILENT;
  21.     fFlags := fFlags or FOF_SIMPLEPROGRESS;
  22.     fFlags := fFlags or FOF_NOCONFIRMMKDIR;
  23.   end;
  24.   Result := (SHFileOperationW(@SHFileOpStruct) = 0);
  25. end;

wp

  • Hero Member
  • *****
  • Posts: 8099
Re: Lazarus problem after new Version
« Reply #2 on: January 27, 2021, 07:45:38 pm »
fpg_oledragdrop.pas(113,23) Error: No matching implementation for interface method "SetData(const tagFORMATETC;var TagSTGMEDIUM;LongBool):LongInt; StdCall;" found

I met this in virtualTreeViews, too. This is how it is solved there:

Code: Pascal  [Select][+][-]
  1. // old declaration
  2.     function SetData(const FormatEtc: TFormatEtc; const Medium: TStgMedium; DoRelease: BOOL): HResult; virtual; stdcall;
  3.  
  4. // new declaration
  5.     function SetData(const FormatEtc: TFormatEtc;
  6.       {$IF FPC_FullVersion >= 30200}var{$ELSE}const{$IFEND} Medium: TStgMedium;
  7.       DoRelease: BOOL): HResult; virtual; stdcall;
  8.  

This means that you must replace the "const" before the TStgMedium parameter by "var" for FPC 3.2+
« Last Edit: January 27, 2021, 07:48:03 pm by wp »
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

Moombas

  • New Member
  • *
  • Posts: 31
Re: Lazarus problem after new Version
« Reply #3 on: January 28, 2021, 08:08:55 am »
Many thanks @ ASerge, i didn't wrote that part by myself but your "corrected" part is fine and works well. So many many thanks for that!

@wp: Thanks for that too, i'll leave it now as it is but if there's coming something strange up, i'll keep this in mind. So, thanks for that too.
The path is the destination but you should never lose sight of the destination on the way.

Moombas

  • New Member
  • *
  • Posts: 31
Re: Lazarus problem after new Version
« Reply #4 on: January 28, 2021, 11:35:00 am »
Now all works fine but when i shut down the programm or run the routine a secondtime i get an exception after i used a copy/execute job (see picture attached).
The strange thing is, that during runtime, there's no error, only when quitting the program... i never had an issue like that, can someone help me how to debug this?

Code: Pascal  [Select][+][-]
  1. procedure TTools.KopierenClick(Sender: TObject);
  2. var
  3.   buttonSelected : Integer;
  4.   PfadA, PfadB   : WideString;
  5.   i              : Integer;
  6. begin
  7.   Fail.Clear;
  8.   Timer3.Interval  := strtoint(Delay.Text) * 1000;
  9.  
  10.   if (Programs.itemindex >= 0) and
  11.      (Programs.Items[Programs.itemindex] <> '.') then
  12.   begin
  13.     if (Data.itemindex >= 0) and
  14.        (split(Data.items[Data.itemindex],'.',1) = 'exe') then
  15.     begin
  16.       if SysUtils.DirectoryExists(KopierenE.Text + Programs.items[Programs.itemindex]) then
  17.       begin
  18.         if DatenC.Checked then
  19.         begin
  20.           StartCopy();
  21.         end else if OriginalE.text <> InstallE.Text then
  22.         begin
  23.           buttonSelected := messagedlg('Das Programm existiert bereits im Installationsordner. Überschreiben?',mtCustom, [mbYes,mbCancel], 0);
  24.           if buttonSelected = mrYes then
  25.           begin
  26.             StartCopy();
  27.           end;
  28.         end else
  29.         begin
  30.           StartCopy();
  31.         end;
  32.       end else
  33.       begin
  34.         StartCopy();
  35.       end;
  36.       LastList.LoadFromFile(KopierenE.Text + Programs.items[Programs.itemindex] + '\test.txt');
  37.       Last.Enabled := True;
  38.     end else if HinweisC.Checked = False then
  39.     begin
  40.       showmessage('Es wurde keine Exe gewählt.');
  41.     end;
  42.  
  43.     PfadA := PfadP + WideString(Programs.items[Programs.itemindex]) + WideString('\test.txt');
  44.     PfadB := WideString(InstallE.Text + Programs.items[Programs.itemindex] + '\test.txt');
  45.     copyfile(PWideChar(PfadA), PWideChar(PfadB), false);
  46.     BezirkS.Enabled    := False;
  47.     FilialeC.Enabled   := False;
  48.     FilialenPS.Enabled := False;
  49.     Manuell.Enabled    := False;
  50.     Last.Enabled       := False;
  51.     DatenC.Enabled     := False;
  52.     FertigC.Enabled    := False;
  53.     LogC.Enabled       := False;
  54.     StartP.Enabled     := False;
  55.     Escape.Enabled     := True;
  56.  
  57.   end else if HinweisC.Checked = False then
  58.   begin
  59.     showmessage('Es wurde kein Programm gewählt.');
  60.   end;
  61. end;
  62.  
  63. //Kopieren starten
  64. procedure TTools.StartCopy();
  65. var
  66.   Status : Bool;
  67. begin
  68.   delete(Widestring(KopierenE.Text + Programs.items[Programs.itemindex]));
  69.   Status := copydir(PfadP + WideString(Programs.items[Programs.itemindex]), WideString(KopierenE.Text));
  70.   if Status then
  71.   begin
  72.     sFileAction      := 'Create';
  73.     Kopieren.Enabled := False;
  74.     NewLog(Widestring(KopierenE.Text + Programs.items[Programs.itemindex]));
  75.     Progress.Visible := True;
  76.     Progress.Position:= 0;
  77.     ProgressTimer.Enabled := True;
  78.     if StartP.checked then
  79.     begin
  80.       startasUser(WideString(KopierenE.Text + Programs.items[Programs.itemindex] + '\' + Data.items[Data.itemindex]), KopierenE.Text + Programs.items[Programs.itemindex] + '\');
  81.     end else
  82.     begin
  83.       Run.Enabled := True;
  84.     end;
  85.   end;
  86. end;    
  87.  
  88. //Prozess als bestimmten Benutzer starten (Hilfsaufruf)
  89. procedure TTools.startasUser(exe: Widestring; param: string);
  90. var
  91.   User              : WideString;
  92.   PW                : WideString;
  93.   err               : DWORD;
  94. begin
  95.   User := 'Test';
  96.   PW   := 'PW';
  97.   err  := CreateProcessAsLogon(User, PW, exe, WideString(param), '');
  98.   if err <> 0 then
  99.   begin
  100.     ShowMessage(SysErrorMessage(err));
  101.   end;
  102. end;  
  103.  
  104. function TTools.CreateProcessAsLogon(const User, PW, Application, param, CmdLine: WideString): DWORD;
  105. var
  106.   ws  : WideString;
  107.   si  : TStartupInfoW;
  108.   pif : TProcessInformation;
  109. begin
  110.   ZeroMemory(@si, sizeof(si));
  111.   si.cb := sizeof(si);
  112.   si.dwFlags := STARTF_USESHOWWINDOW;
  113.   si.wShowWindow := 1;
  114.  
  115.   if CmdLine = '' then
  116.   begin
  117.     ws := Application;
  118.   end else
  119.   begin
  120.     ws := Application + ' "' + CmdLine + '"';
  121.   end;
  122.  
  123.   SetLastError(0);
  124.   SI.cb  := SizeOf(TStartupInfo);
  125.   if CreateProcessWithLogonW(PWideChar(User), nil, PWideChar(PW), 0, nil, PWideChar(ws), CREATE_DEFAULT_ERROR_MODE, nil, PWideChar(param), @si, @pif) then
  126.   begin
  127.     sleep(500);
  128.     if PIf.dwProcessId > 0 then
  129.     begin
  130.       AppPID := PIf.dwProcessId;
  131.       CloseHandle(PIf.hProcess);
  132.       CloseHandle(PIf.hThread);
  133.     end;
  134.   end;
  135.   Result := GetLastError;
  136. end;
  137.  
  138. function CreateProcessWithLogonW(lpUsername, lpDomain, lpPassword: LPWSTR; dwLogonFlags: dword; lpApplicationName,
  139.   lpCommandLine: LPWSTR; dwCreationFlags: dword; lpEnvironment: pointer; lpCurrentDirectory: LPWSTR; lpStartupInfo:
  140.   PStartUpInfoW; lpProcessInfo: PProcessInformation): boolean; stdcall; external 'advapi32.dll';
  141.  
  142. procedure TTools.OnNotifySynchronized();
  143. begin
  144.   Timer3.Enabled := true;
  145. end;      
  146.  
  147. procedure TTools.OnNotify(const FilePath: WideString; const Action: TDirectoryEventType);
  148. var
  149.   start, i : integer;
  150.   FileName : WideString;
  151. begin
  152.   FileName := '';
  153.   start := 1;
  154.   for i := length(FilePath) downto 1 do
  155.   begin
  156.     if FilePath[i] = '\' then
  157.     begin
  158.       start := i + 1;
  159.       break;
  160.     end;
  161.   end;
  162.  
  163.   for i := start to length(FilePath) do
  164.   begin
  165.     FileName := FileName + FilePath[i];
  166.   end;
  167.  
  168.   if (Split(String(FileName), '2', 0) = 'Log') or
  169.      (Split(String(FileName), '2', 0) = 'log') then
  170.   begin
  171.     case Action of
  172.       detAdded: begin
  173.                   Instant.Enabled := True;
  174.                   Run.Enabled     := False;
  175.                   LogL.Caption    := String(Filename + ' gefunden.');
  176.                   LogL.Left       := 72;
  177.                   LogA.Caption    := 'Logdatei prüfen...';
  178.                   LogA.Show;
  179.                   sFileAction     := 'Edited';
  180.                   //Watch.Stop;
  181.                   //Watch.Destroy
  182.                   LogDatei        := Filename;
  183.                   LogName         := FilePath;
  184.                   LogA.Caption    := DateTimeToStr(ReportFileTimes(LogName));
  185.                   LogA.Left       := 72;
  186.                   FileChange      := ReportFileTimes(LogName);
  187.                   olddate         := FileChange;
  188.                   TThread.Synchronize(nil, OnNotifySynchronized);
  189.                 end;
  190.       detRemoved: ;
  191.       detModified: ;
  192.     end;
  193.   end;
  194. end;
  195.  
  196. procedure TTools.NewLog(Path : WideString);
  197. begin
  198.   if sFileAction = 'Create' then
  199.   begin
  200.     if SysUtils.ForceDirectories(Path) then
  201.     begin
  202.       LogL.Caption       := 'Auf Log Datei warten...';
  203.       LogL.Show;
  204.       Programs.Enabled   := False;
  205.       Data.Enabled       := False;
  206.       TxTLogs.Enabled    := False;
  207.       Watch              := TDirectoryWatcherBuilder.New
  208.                                                     .WatchDirectory(Path)
  209.                                                     .Recursively(False)
  210.                                                     .OnChangeTrigger(OnNotify)
  211.                                                     .Build;
  212.       Watch.Start;
  213.     end else
  214.     begin
  215.       MessageDlg('Verzeichnis konnte nicht erstellt werden', TMsgDlgType.mtError, [mbOK], 0);
  216.     end;
  217.   end;
  218. end;  
  219.  
  220. procedure TTools.Timer3Timer(Sender: TObject);
  221.   function GetProcessHandleFromID(ID: DWORD): THandle;
  222.   begin
  223.     result := OpenProcess(SYNCHRONIZE, False, ID);
  224.     CloseHandle(result);
  225.   end;
  226. begin
  227.   if fileexists(String(LogName)) then
  228.   begin
  229.     newdate := ReportFileTimes(WideString(LogName));
  230.     if newdate <> olddate then
  231.     begin
  232.       olddate := newdate;
  233.       Timer3.Enabled := True;
  234.     end else if AppPID <> 0 then
  235.     begin
  236.       if GetProcessHandleFromID(AppPID) = 0 then
  237.       begin
  238.         Timer3.Enabled   := False;
  239.         Progress.Visible := False;
  240.         ProgressTimer.Enabled := False;
  241.         if FertigC.Checked then
  242.         begin
  243.           FertigClick(Sender);
  244.         end else
  245.         begin
  246.           Fertig.Enabled := True;
  247.         end;
  248.         Run.Enabled      := False;
  249.         Programs.Enabled := True;
  250.         Data.Enabled     := True;
  251.         TxTLogs.Enabled  := True;
  252.         Escape.Enabled   := False;
  253.         LogA.Caption     := 'Programm fertig.';
  254.         Timer3.Enabled   := False;
  255.         AppPID           := 0;
  256.       end;
  257.     end else
  258.     begin
  259.       showmessage('Es wurde kein Programm gefunden!');
  260.       Timer3.Enabled   := False;
  261.       Progress.Visible := False;
  262.       ProgressTimer.Enabled := False;
  263.       if FertigC.Checked then
  264.       begin
  265.         FertigClick(Sender);
  266.       end else
  267.       begin
  268.         Fertig.Enabled := True;
  269.       end;
  270.       Run.Enabled      := False;
  271.       Programs.Enabled := True;
  272.       Data.Enabled     := True;
  273.       TxTLogs.Enabled  := True;
  274.       Escape.Enabled   := False;
  275.       LogA.Caption     := 'Programm nicht gefunden!';
  276.       Timer3.Enabled   := False;
  277.     end;
  278.   end;
  279. end;  
  280.  
« Last Edit: January 28, 2021, 02:37:15 pm by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

Moombas

  • New Member
  • *
  • Posts: 31
Re: Lazarus problem after new Version
« Reply #5 on: January 28, 2021, 12:03:00 pm »
After some Debugger settings i found, the error here:

Code: Pascal  [Select][+][-]
  1. destructor TDirectoryWatcherThreadWindows.Destroy;
  2. begin
  3.   try  
  4.     if FhFile <> INVALID_HANDLE_VALUE then
  5.     begin
  6.       CloseHandle(FhFile);
  7.     end;
  8.  
  9.     CloseHandle(FileEvent); // Error is here
  10.     TermEvent.Free;
  11.     SuspEvent.Free;
  12.   except
  13.   end;
  14.  
  15.   FEventTriggerThread.FreeOnTerminate := True;
  16.   FEventTriggerThread.Terminate;
  17.   inherited;
  18. end;
  19.  

But this is in DirectoryWatcherThreadWindows.windows which is a lazarus unit, so whats going wrong here?
Did i forgot to close/free this anywhere?
« Last Edit: January 29, 2021, 01:34:28 pm by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

Fred vS

  • Hero Member
  • *****
  • Posts: 2083
    • StrumPract is the musicians best friend
Re: Lazarus problem after new Version
« Reply #6 on: January 28, 2021, 01:21:10 pm »
Hello.

Are you using fpGUI via LCL (Lazarus widget) ?

If so it is possible that there are problems.
LCL-fpGUI is work-in-progress state, you should use "Pure fpGUI" instead.
https://github.com/graemeg/fpGUI/tree/maint

Fre;D

I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

Moombas

  • New Member
  • *
  • Posts: 31
Re: Lazarus problem after new Version
« Reply #7 on: January 28, 2021, 02:08:55 pm »
@Fred vS: How to check that? This "project" is quite old and long untouched, so sorry for the stupid question.

But does it really take effect on directorywatcher?
The path is the destination but you should never lose sight of the destination on the way.

Fred vS

  • Hero Member
  • *****
  • Posts: 2083
    • StrumPract is the musicians best friend
Re: Lazarus problem after new Version
« Reply #8 on: January 28, 2021, 04:38:40 pm »
@Fred vS: How to check that? This "project" is quite old and long untouched, so sorry for the stupid question.

But does it really take effect on directorywatcher?

If your project was created via Lazarus and you did choose in project option: LCLWidgetType:=fpgui then for sure it is the LCL-fpGUI widget that is used.

You may check this in your code of unit "program".

If there is in uses section: interfaces then LCL widgetset is used, otherwise it is a "Pure fpGUI" widget used.

Anyway, if you a had success with WidgetType:=fpgui with older version of Lazarus and now problems appear, please create a issue here:
https://github.com/graemeg/fpGUI/issues

Fre;D
« Last Edit: January 28, 2021, 04:44:23 pm by Fred vS »
I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

Moombas

  • New Member
  • *
  • Posts: 31
Re: Lazarus problem after new Version
« Reply #9 on: January 29, 2021, 07:43:57 am »
Ok, so i seem to use the working version, because "interfaces" are not in uses.
But i still have the directorywatcher problem :(
The path is the destination but you should never lose sight of the destination on the way.

Moombas

  • New Member
  • *
  • Posts: 31
Re: Lazarus problem after new Version
« Reply #10 on: January 29, 2021, 12:07:29 pm »
I read in a different Thread that SIGSEGV (there) could be because of a dll call, which happens here too. Can someone help me here? I'm really helpless at the moment. :'(
« Last Edit: January 29, 2021, 01:33:43 pm by Moombas »
The path is the destination but you should never lose sight of the destination on the way.

 

TinyPortal © 2005-2018