{ Double Commander ------------------------------------------------------------------------- WLX-API implementation. (TC WLX-API v1.8) Copyright (C) 2008 Dmitry Kolomiets (B4rr4cuda@rambler.ru) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA } unit uwlxmodule; {$mode objfpc}{$H+} interface uses Classes, SysUtils, dynlibs, uDetectStr, uwlxprototypes, WLXPlugin, uClassesEx, uDCUtils, uGlobs,LCLProc {$IFDEF LCLGTK} ,gtk,glib,gdk {$ENDIF} {$IFDEF LCLGTK2} ,gtk2,glib2,gdk2 {$ENDIF} {$IFDEF LCLQT} ,qt4,qtwidgets // The Qt widgetset must be used to load plugins on qt {$ENDIF} ; type { TWLXModule } TWLXModule = class protected //a) Mandatory (must be implemented) ListLoad:TListLoad; //b) Optional (must NOT be implemented if unsupported!) ListLoadNext:TListLoadNext; ListCloseWindow:TListCloseWindow; ListGetDetectString:TListGetDetectString; ListSearchText:TListSearchText; ListSearchDialog:TListSearchDialog; ListSendCommand:TListSendCommand; ListPrint:TListPrint; ListNotificationReceived:TListNotificationReceived; ListSetDefaultParams:TListSetDefaultParams; ListGetPreviewBitmap:TListGetPreviewBitmap; private FModuleHandle:TLibHandle; // Handle to .DLL or .so FForce:boolean; FParser:TParserControl; FPluginWindow:THandle; function GIsLoaded:boolean; public Name:string; FileName:string; DetectStr:string; pShowFlags:integer; //--------------------- constructor Create; destructor Destroy; override; //--------------------- function LoadModule:Boolean; procedure UnloadModule; //--------------------- function CallListLoad(ParentWin:THandle; FileToLoad:string; ShowFlags:integer):THandle; function CallListLoadNext(ParentWin: THandle; FileToLoad: string; ShowFlags: integer): integer; function CallListGetDetectString:string; procedure CallListSetDefaultParams; procedure CallListCloseWindow; function CallListGetPreviewBitmap(FileToLoad: string; width, height: integer; contentbuf: string): hbitmap; function CallListNotificationReceived(Msg, wParam, lParam: integer): integer; function CallListPrint(FileToPrint, DefPrinter: string; PrintFlags: integer; var Margins: trect): integer; function CallListSearchDialog(FindNext: integer): integer; function CallListSearchText(SearchString: string; SearchParameter: integer): integer; function CallListSendCommand(Command, Parameter: integer): integer; //--------------------- // function FileParamVSDetectStr(ptr:PFileRecItem):boolean; overload; function FileParamVSDetectStr(AFileName:String):boolean; //overload; //--------------------- property IsLoaded:boolean read GIsLoaded; property ModuleHandle:TLibHandle read FModuleHandle write FModuleHandle; property Force:boolean read FForce write FForce; property PluginWindow:THandle read FPluginWindow; end; { TWLXModuleList } TWLXModuleList = class private Flist:TStringList; function GetCount:integer; public //--------------------- constructor Create; destructor Destroy; override; //--------------------- procedure Clear; procedure Load(FileName:string);overload; procedure Load(Ini:TIniFileEx); overload; procedure Save(FileName:string);overload; procedure Save(Ini:TIniFileEx); overload; procedure DeleteItem(Index: integer); //--------------------- function Add(Item:TWLXModule):integer;overload; function Add(FileName:string):integer;overload; function Add(AName,FileName,DetectStr:string):integer;overload; //--------------------- function IsLoaded(AName:String):Boolean;overload; function IsLoaded(Index: integer):Boolean;overload; function LoadModule(AName:String):Boolean; overload; function LoadModule(Index: integer): Boolean; overload; //--------------------- function GetWLxModule(Index:integer):TWLXModule;overload; function GetWlxModule(AName:string):TWLXModule;overload; //--------------------- //--------------------- //property WlxList:TStringList read Flist; property Count:integer read GetCount; end; Function WlxPrepareContainer(Ahandle:THandle; revert:boolean=false):boolean; implementation uses FileUtil; function WlxPrepareContainer(Ahandle: THandle; revert:boolean=false): boolean; {$IFNDEF LCLWIN32} {$IFNDEF LCLQT} var lst:PGList; {$ENDIF} {$ENDIF} begin {$IFNDEF LCLWIN32} {$IFNDEF LCLQT} if not revert then begin //Hide controls from our gtk container lst:=gtk_container_children(GTK_CONTAINER(PGtkwidget(AHandle))); if lst<>nil then begin gtk_widget_hide(PGtkWidget(lst^.data)); Result:=true; end else Result:=false; Exit; end else begin //Show controls from our gtk container lst:=gtk_container_children(GTK_CONTAINER(PGtkwidget(AHandle))); if lst<>nil then begin gtk_widget_show(PGtkWidget(lst^.data)); Result:=true; end else Result:=false; Exit; end; {$ENDIF} {$ENDIF} Result:=true end; { TWLXModule } function TWLXModule.GIsLoaded: boolean; begin Result:=FModuleHandle<>0; end; constructor TWLXModule.Create; begin FParser:=TParserControl.Create; end; destructor TWLXModule.Destroy; begin if GIsLoaded then UnloadModule; if assigned(FParser) then FParser.Free; inherited Destroy; end; function TWLXModule.LoadModule: Boolean; begin // DebugLn('WLXM LoadModule entered'); FModuleHandle := LoadLibrary(Self.FileName); Result := (FModuleHandle <> 0); if FModuleHandle = 0 then exit; ListLoad:=TListLoad(GetProcAddress(FModuleHandle,'ListLoad')); ListLoadNext:=TListLoadNext(GetProcAddress(FModuleHandle,'ListLoadNext')); ListCloseWindow:=TListCloseWindow(GetProcAddress(FModuleHandle,'ListCloseWindow')); ListGetDetectString:=TListGetDetectString(GetProcAddress(FModuleHandle,'ListGetDetectString')); ListSearchText:=TListSearchText(GetProcAddress(FModuleHandle,'ListSearchText')); ListSearchDialog:=TListSearchDialog(GetProcAddress(FModuleHandle,'ListSearchDialog')); ListSendCommand:=TListSendCommand(GetProcAddress(FModuleHandle,'ListSendCommand')); ListPrint:=TListPrint(GetProcAddress(FModuleHandle,'ListPrint')); ListNotificationReceived:=TListNotificationReceived(GetProcAddress(FModuleHandle,'ListNotificationReceived')); ListSetDefaultParams:=TListSetDefaultParams(GetProcAddress(FModuleHandle,'ListSetDefaultParams')); ListGetPreviewBitmap:=TListGetPreviewBitmap(GetProcAddress(FModuleHandle,'ListGetPreviewBitmap')); //DebugLn('WLXM LoadModule Leaved'); end; procedure TWLXModule.UnloadModule; begin // DebugLn('Try to call ListCloseWindow'); CallListCloseWindow; // DebugLn('Call ListCloseWindow succses'); if FModuleHandle <> 0 then FreeLibrary(FModuleHandle); FModuleHandle := 0; ListLoad:=nil; ListLoadNext:=nil; ListCloseWindow:=nil; ListGetDetectString:=nil; ListSearchText:=nil; ListSearchDialog:=nil; ListSendCommand:=nil; ListPrint:=nil; ListNotificationReceived:=nil; ListSetDefaultParams:=nil; ListGetPreviewBitmap:=nil; end; function TWLXModule.CallListLoad(ParentWin: THandle; FileToLoad: string; ShowFlags: integer): THandle; begin if not assigned(ListLoad) then exit; //To prevent crash. {$IFDEF LCLQT} FPluginWindow:=ListLoad(Integer(TQtWidget(ParentWin).GetContainerWidget), pChar(UTF8ToSys(FileToLoad)), ShowFlags); {$ENDIF} {$IFNDEF LCLQT} FPluginWindow:=ListLoad(ParentWin, pChar(UTF8ToSys(FileToLoad)), ShowFlags); {$ENDIF} Result:=FPluginWindow; end; function TWLXModule.CallListLoadNext(ParentWin: THandle; FileToLoad: string; ShowFlags: integer): integer; begin if assigned(ListLoadNext) then {$IFDEF LCLQT} Result:=ListLoadNext(Integer(TQtWidget(ParentWin).GetContainerWidget),FPluginWindow, pChar(UTF8ToSys(FileToLoad)), ShowFlags); {$ENDIF} {$IFNDEF LCLQT} Result:=ListLoadNext(ParentWin,FPluginWindow,PChar(UTF8ToSys(FileToLoad)),ShowFlags) {$ENDIF} //else Result:=LISTPLUGIN_ERROR; end; procedure TWLXModule.CallListCloseWindow; begin if not assigned(ListCloseWindow) then exit; try ListCloseWindow(FPluginWindow); finally FPluginWindow:=0; end; end; function TWLXModule.CallListGetDetectString: string; var pc:Pchar; begin //DebugLn('GetDetectstr Entered'); if assigned(ListGetDetectString) then begin GetMem(pc,MAX_PATH); ListGetDetectString(pc,MAX_PATH); Result:=StrPas(pc); FreeMem(pc); end else Result:=''; //DebugLn('GetDetectStr Leaved'); end; function TWLXModule.CallListSearchText(SearchString: string; SearchParameter: integer): integer; begin if Assigned(ListSearchText) then begin Result:=ListSearchText(FPluginWindow, PChar(UTF8ToSys(SearchString)), SearchParameter); end else Result:=LISTPLUGIN_ERROR; end; function TWLXModule.CallListSearchDialog(FindNext: integer ): integer; begin if Assigned(ListSearchDialog) then begin Result:=ListSearchDialog(FPluginWindow, FindNext); end else Result:=LISTPLUGIN_ERROR; end; function TWLXModule.CallListSendCommand(Command, Parameter: integer): integer; begin if Assigned(ListSendCommand) then begin Result:=ListSendCommand(FPluginWindow, Command, Parameter); end else Result:=LISTPLUGIN_ERROR; end; {function TWLXModule.FileParamVSDetectStr(ptr: PFileRecItem): boolean; begin FParser.DetectStr:=Self.DetectStr; Result:=FParser.TestFileResult(ptr); end;} function TWLXModule.FileParamVSDetectStr(AFileName: String): boolean; begin FParser.DetectStr:=Self.DetectStr; DebugLn('DetectStr = '+FParser.DetectStr); DebugLn('AFileName = '+AFileName); Result:=FParser.TestFileResult(AFileName); end; function TWLXModule.CallListPrint(FileToPrint, DefPrinter: string; PrintFlags: integer; var Margins: trect): integer; begin if Assigned(ListPrint) then begin Result:=ListPrint(FPluginWindow, PChar(UTF8ToSys(FileToPrint)), PChar(DefPrinter), PrintFlags, Margins); end else Result:=LISTPLUGIN_ERROR; end; function TWLXModule.CallListNotificationReceived(Msg, wParam, lParam: integer): integer; begin if Assigned(ListNotificationReceived) then begin Result:=ListNotificationReceived(FPluginWindow, Msg, wParam,lParam); end; end; procedure TWLXModule.CallListSetDefaultParams; var dps:pListDefaultParamStruct; begin if not assigned(ListSetDefaultParams) then exit; GetMem(dps,SizeOf(tListDefaultParamStruct)); dps^.DefaultIniName:=gini.FileName; dps^.PluginInterfaceVersionHi:=1; dps^.PluginInterfaceVersionLow:=80; dps^.size:=SizeOf(tListDefaultParamStruct); ListSetDefaultParams(dps); FreeMem(dps,SizeOf(tListDefaultParamStruct)); end; function TWLXModule.CallListGetPreviewBitmap(FileToLoad: string; width, height: integer; contentbuf: string): hbitmap; begin if Assigned(ListGetPreviewBitmap) then Result:=ListGetPreviewBitmap(PChar(UTF8ToSys(FileToLoad)), width, height, PChar(contentbuf), length(contentbuf)); end; { TWLXModuleList } function TWLXModuleList.GetCount: integer; begin if Assigned(Flist) then Result:=Flist.Count else Result:=0; end; constructor TWLXModuleList.Create; begin Flist:=TStringList.Create; end; destructor TWLXModuleList.Destroy; begin while Flist.Count>0 do begin if assigned(TWLXModule(Flist.Objects[0])) then TWLXModule(Flist.Objects[0]).Free; Flist.Delete(0); end; FreeAndNil(Flist); inherited Destroy; end; procedure TWLXModuleList.Clear; begin while Flist.Count>0 do begin TWLXModule(Flist.Objects[0]).Free; Flist.Delete(0); end; end; procedure TWLXModuleList.Load(FileName: string); var Ini:TIniFileEx; begin try Ini:=TIniFileEx.Create(FileName); Load(Ini); finally Ini.Free; end; end; procedure TWLXModuleList.Load(Ini: TIniFileEx); var xCount,I:integer; tmp:string; begin Self.Clear; xCount:=Ini.ReadInteger('Lister Plugins','PluginCount',0); if xCount=0 then Exit; For i:=0 to xCount-1 do begin tmp:=Ini.ReadString('Lister Plugins','Plugin'+IntToStr(I+1)+'Name',''); Flist.AddObject(UpCase(tmp),TWLXModule.Create); TWLXModule(Flist.Objects[I]).Name:=tmp; TWLXModule(Flist.Objects[I]).DetectStr:=Ini.ReadString('Lister Plugins','Plugin'+IntToStr(I+1)+'Detect',''); TWLXModule(Flist.Objects[I]).FileName:=GetCmdDirFromEnvVar(Ini.ReadString('Lister Plugins','Plugin'+IntToStr(I+1)+'Path','')); end; end; procedure TWLXModuleList.Save(FileName: string); var Ini:TIniFileEx; begin try Ini:=TIniFileEx.Create(FileName); Save(Ini); finally Ini.Free; end; end; procedure TWLXModuleList.Save(Ini: TIniFileEx); var i:integer; begin Ini.EraseSection('Lister Plugins'); Ini.WriteInteger('Lister Plugins','PluginCount',Flist.Count); For i:=0 to Flist.Count-1 do begin Ini.WriteString('Lister Plugins','Plugin'+IntToStr(I+1)+'Name',TWLXModule(Flist.Objects[I]).Name); Ini.WriteString('Lister Plugins','Plugin'+IntToStr(I+1)+'Detect',TWLXModule(Flist.Objects[I]).DetectStr); Ini.WriteString('Lister Plugins','Plugin'+IntToStr(I+1)+'Path',SetCmdDirAsEnvVar(TWLXModule(Flist.Objects[I]).FileName)); end; end; procedure TWLXModuleList.DeleteItem(Index: integer); begin if (Index>-1) and (Index0 then delete(s,pos('.',s),length(s)); Result:=Flist.AddObject(UpCase(s),TWLXModule.Create); TWLXModule(Flist.Objects[Result]).Name:=s; TWLXModule(Flist.Objects[Result]).FileName:=FileName; if TWLXModule(Flist.Objects[Result]).LoadModule then begin TWLXModule(Flist.Objects[Result]).DetectStr:=TWLXModule(Flist.Objects[Result]).CallListGetDetectString; TWLXModule(Flist.Objects[Result]).UnloadModule; end; // DebugLn('WLXLIST ADD Leaved'); end; function TWLXModuleList.Add(AName, FileName, DetectStr: string): integer; begin Result:=Flist.AddObject(UpCase(AName),TWLXModule.Create); TWLXModule(Flist.Objects[Result]).Name:=AName; TWLXModule(Flist.Objects[Result]).DetectStr:=DetectStr; TWLXModule(Flist.Objects[Result]).FileName:=FileName; end; function TWLXModuleList.IsLoaded(AName: String): Boolean; var x:integer; begin x:=Flist.IndexOf(AName); if x=-1 then Result:=false else begin Result:=GetWLxModule(x).IsLoaded; end; end; function TWLXModuleList.IsLoaded(Index: integer): Boolean; begin Result:=GetWLxModule(Index).IsLoaded; end; function TWLXModuleList.LoadModule(AName: String): Boolean; var x:integer; begin x:=Flist.IndexOf(UpCase(AName)); if x=-1 then Result:=false else begin Result:=GetWlxModule(x).LoadModule; end; end; function TWLXModuleList.LoadModule(Index: integer): Boolean; begin Result:=GetWlxModule(Index).LoadModule; end; function TWLXModuleList.GetWLxModule(Index: integer): TWLXModule; begin Result:=TWLXModule(Flist.Objects[Index]); end; function TWLXModuleList.GetWlxModule(AName: string): TWLXModule; var tmp:integer; begin tmp:=Flist.IndexOf(upcase(AName)); if tmp>-1 then Result:=TWLXModule(Flist.Objects[tmp]); end; end.