| View previous topic :: View next topic |
| Author |
Message |
AlexEr81
Joined: 27 Jan 2017
Posts: 2
|
 (Separately) Posted: Fri Jan 27, 2017 10:40 Post subject: wlxПлагин tcmd 32bit->64bit |
 |
|
Здравствуйте! Пример ListSimple
на Lazarus Не удало перенести. нашел более простой код:
пример простейшего плагина для листера:
| Code: | library txtplg;
{$mode objfpc}{$H+}
uses
Classes, unMain,SysUtils,FORMS, Interfaces,windows
{ you can add units after this };
const
PARSE_FUNCTION = 'EXT="TXT"|EXT="PAS"|EXT="LFM"';
SUPPORT_EXT = '.TXT';
SUPPORT_EXT2 = '.PAS';
SUPPORT_EXT3 = '.LFM';
procedure ListGetDetectString(DetectString: PChar; MaxLen: integer); stdcall;
begin
StrLCopy(DetectString, PChar(PARSE_FUNCTION), MaxLen);
end;
function FileExtIsFits(FileToLoad: Pchar): Boolean;
begin
if (UpperCase(ExtractFileExt(FileToLoad)) <> SUPPORT_EXT) and (UpperCase(ExtractFileExt(FileToLoad)) <> SUPPORT_EXT2)
and (UpperCase(ExtractFileExt(FileToLoad)) <> SUPPORT_EXT3)
then Result := False
else Result := true;
end;
function ListLoad(ListerWin: HWND; FileToLoad: Pchar; ShowFlags: integer): HWND; stdcall;
begin
Result := 0;
if FileExtIsFits(FileToLoad) then
Result := TfmMain.PluginShow(ListerWin, FileToLoad)
end;
function ListLoadNext(ListerWin, PluginWin: HWND; FileToLoad: Pchar; ShowFlags: Integer): Integer; stdcall;
begin
if FileExtIsFits(FileToLoad) then
Result := TfmMain.PluginShowNext(PluginWin, string(FileToLoad))
else
Result := 0;
end;
procedure ListCloseWindow(PluginWin: HWND); stdcall;
begin
TfmMain.PluginHide(PluginWin);
end;
exports
ListGetDetectString,
ListLoad,
ListLoadNext,
ListCloseWindow;
begin
Application.Initialize;
end. |
| Code: | unit unMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,StdCtrls,lcltype,windows, Forms, Controls;
type
{ TfmMain }
TfmMain = class(TForm)
Memo1: TMemo;
private
FTotCmdWin: HWND; // handle of TotalCommander window
FParentWin: HWND; // handle of Lister window
FQuickView: Boolean; // Ctrl+Q panel
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor CreateParented(AParentWindow: HWND);
public
class function PluginShow(ListerWin: HWND; FileToLoad: string): HWND;
class function PluginShowNext(PluginWin: HWND; FileToLoad: string): Integer;
class function PluginHide(PluginWin: HWND): HWND;
end;
implementation
{$R *.lfm}
class function TfmMain.PluginShow(ListerWin: HWND; FileToLoad: string): HWND;
var
fmMain: TfmMain;
begin
fmMain := nil;
try
fmMain := TfmMain.CreateParented(ListerWin);
fmMain.memo1.Lines.LoadFromFile(FileToLoad);
fmMain.Show;
SetWindowLongPTR(fmMain.Handle, GWL_USERDATA, PtrInt(fmMain));
// set focus to our window
if not fmMain.FQuickView then
begin
PostMessage(fmMain.Handle, WM_SETFOCUS, 0, 0);
fmMain.SetFocus;
end;
Result := fmMain.Handle;
except
if Assigned(fmMain) then
fmMain.Free;
Result := 0;
end;
end;
class function TfmMain.PluginShowNext(PluginWin: HWND; FileToLoad: string): Integer;
var
fmMain: TfmMain;
begin
fmMain := TfmMain(GetWindowLongPTR(PluginWin, GWL_USERDATA));
try
fmMain.Show;
fmMain.memo1.Lines.LoadFromFile(FileToLoad);
Result := 0;
except
Result := 1;
end;
end;
class function TfmMain.PluginHide(PluginWin: HWND): HWND;
var
fmMain: TfmMain;
begin
Result := 0;
fmMain := TfmMain(GetWindowLongPTR(PluginWin, GWL_USERDATA));
try
fmMain.Free;
except
end;
end;
procedure TfmMain.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := (WS_CHILD or WS_MAXIMIZE) and not WS_CAPTION and not WS_BORDER;
Params.WindowClass.cbWndExtra := SizeOf(PtrInt); // ~4/8 bytes for form
end;
constructor TfmMain.CreateParented(AParentWindow: HWND);
begin
inherited CreateParented(AParentWindow);
FTotCmdWin := FindWindow('TTOTAL_CMD', nil);
FParentWin := AParentWindow;
FQuickView := Windows.GetParent(FParentWin) <> 0;
end;
end. |
| Code: | object fmMain: TfmMain
Left = 234
Height = 240
Top = 139
Width = 320
BorderStyle = bsNone
Caption = 'fmMain'
ClientHeight = 240
ClientWidth = 320
LCLVersion = '1.6.2.0'
object Memo1: TMemo
Left = 0
Height = 240
Top = 0
Width = 320
Align = alClient
TabOrder = 0
end
end |
под 32 бит работает. а под 64 бит в Memo1 файл загружается а дальше вылетает ошибка
| Quote: | ---------------------------
Total Commander 9.0a
---------------------------
Access violation.
Access violation
Windows 7 SP1 6.1 (Build 7601), base: 0400000
Please report this error to the Author, with a description
of what you were doing when this error occurred!
Stack trace (x64):40A700
4312C2 43E721 43E436 44040C 440881 78CDCC 440827 404895
Press Ctrl+C to copy this report!
Continue execution?
---------------------------
Да Нет
--------------------------- |
и тотал коммандер закрывается. подскажите пожалуйста что в коде не так? |
|
| Back to top |
|
 |
ProgMan13
Joined: 19 Aug 2009
Posts: 336
|
| (Separately) Posted: Wed Feb 01, 2017 20:25 Post subject: |
|
|
AlexEr81
{$A8} или {$mode delphiunicode}? |
|
| Back to top |
|
|
black_cat
Joined: 10 Feb 2017
Posts: 2
|
| (Separately) Posted: Fri Feb 10, 2017 23:49 Post subject: Re: wlxПлагин tcmd 32bit->64bit |
|
|
| AlexEr81 wrote: |
под 32 бит работает. а под 64 бит в Memo1 файл загружается а дальше вылетает ошибка
...
и тотал коммандер закрывается. подскажите пожалуйста что в коде не так? |
В общем, на основе вашего текста (правда увидел я его на другом форуме, но не важно) наваял свой мелкий плагин. В итоге проблема похожая, только все же другая.
Под ХР плагин отлично работает, перетащил на 7 64 - работать отказался. Только без выдачи ошибки и падения Тотала. После вывода в мемо (до его отображения), Листер переключался в режим текста и все.
Поставил галочку "Граф приложение вин32" в Настройках проекта, и плагин успешно взлетел. |
|
| Back to top |
|
|
AlexEr81
Joined: 27 Jan 2017
Posts: 2
|
| (Separately) Posted: Mon Feb 27, 2017 12:13 Post subject: |
|
|
ошибка появляется так: если курсор отвести в сторону от тотала. то ошибка не появится, и тотал и запущенный плагин будут работать нормально.закрываться без ошибок. пока курсор мыши не появится над окном плагина.
total commander 9.0a 64 бит
Lazarus 1.6.2 64 бит
галочка "Граф приложение вин32" не помогла.
P.s неработает плагин в 64 битном тотале, в 32битном работает без ошибок и на WINXP32 и на WIN7_64 |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
