- Код: Выделить всё
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.
- Код: Выделить всё
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.
- Код: Выделить всё
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 файл загружается а дальше вылетает ошибка
---------------------------
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?
---------------------------
Да Нет
---------------------------
и тотал коммандер закрывается. подскажите пожалуйста что в коде не так?