Directory Processor Code

unit BaseModule;

 {$mode delphi}

interface

uses
  Classes, SysUtils, process, FileUtil, IniFiles, Controls, Forms, LCLType,dynlibs;
  type TInfoProc = function(what:string):string; stdcall;
       TEditProc = function(Params:string;MyApp:TApplication):string; stdcall;
       TWorkProc = procedure(InFile, OutFile, Params:string); stdcall;
       TProc = procedure;
       PTrans=^TTrans;
       TTrans=record
         ExFr:string;
         ExTo:string;
         Action:string;
         Params:string;
 //        Next:PTrans
       end;
       TTransl = Class (TList)
         private
           function Edit_(tr:PTrans):boolean;
           function EditDll(tr:PTrans):boolean;
           function Search(ExFr:string):PTrans;
           procedure Delete_(p:Ptrans);
          public
           destructor Destroy; override;
           function ExtTrans(ExFr:string): TTrans;
           function Edit(ExFr:string):boolean;
           function AsStringList:TStringList;
        //   function ToDo(Ext:string):string;
           function  Newfilename(filename,ext:string):string;
           function AddNew(ExFr:string):boolean;
           function IsNull:boolean;
           procedure SaveToIni(filename:string);
           function AddChk(ExFr:string):boolean;
           function IsExt(ExFr:string):boolean;
       end;
       TPlugin=Class
            private
               Myid:string;
               //Myname:string;
               Myfilename:string;
               libHandle:TLibHandle;
               function MyName:string;
            public
               Info:TInfoProc;
               Edit:TEditProc;
               Work:TWorkProc;
             // procedure Work(InFile, OutFile, Params:string);
             public
               property id:string read Myid;
               property name:string read Myname;
              // property filename:string read Myfilename;
               constructor Create (aId,aFile:String;aHandle:TLibHandle);
               destructor Destroy; override;
       end;
       TPlugins=Class(TList)
         private
           procedure LoadLib(FileIterator: TFileIterator);
           function GetName(Index: Integer): string;
         protected
           property Items;
           function GetPlugin(Index:integer):TPlugin;
         public
           function IdNumber(id:string):integer;
           function ById(id:string):TPlugin;
           destructor Destroy; override;
           procedure LoadLibs;
           function NamesList:TStringList;
           property Names[Index:integer]:string read GetName;
           property Plugin[Index:integer]:TPlugin read GetPlugin; default;
       end;


//function StringsToList(strings:array of string):TStringList;
procedure Transform(DirFrom,DirTo:string;Files:TStringList);
procedure FileDo(OldD,OldF,NewD,NewF,Act:string);
procedure FileDoDll(OldD,OldF,NewD:string;ToDo:TTrans);
function TranslFromIni(filename:string):TTransl;
function GetParamByname(ParName:string):string;

var  Transl:TTransl;
     Plugins:TPlugins;

implementation
uses  ExtEditor, ExtDll;

function GetParamByname(ParName:string):string;
var i,n:integer;
    res:string;
begin
  res:=ParamStr(0);
  res:=ParamStr(1);
  res:='';
  n:=ParamCount;
  for i:= 1 to ParamCount do
  begin
    n:=Pos('=',ParamStr(i));
    if n>0 then
    begin
      if LeftStr(ParamStr(i),n-1)=ParName then
         Res:=Copy(ParamStr(i),n+1,Length(ParamStr(i))-n);
    end
     else
    begin
      if ParamStr(i)=ParName then Res:='True';
    end;
  end;
  Result:=Res;
end;
constructor TPlugin.Create(aId,aFile:String;aHandle:TLibHandle);
var InfoProc:TInfoProc;
    EditProc:TEditProc;
    WorkProc:TWorkProc;
begin
  self.Myid:=aId;
  //self.Myname:=aName;
  self.Myfilename:=aFile;
  self.libHandle:=aHandle;
  @InfoProc:=GetProcAddress(aHandle,'Info');
  @WorkProc:=GetProcAddress(aHandle,'Work');
  @EditProc:=GetProcAddress(aHandle,'Edit');
  self.Info:=InfoProc;
  self.Edit:=EditProc;
  self.Work:=WorkProc;
end;

destructor TPlugin.Destroy;
begin
  FreeLibrary(self.LibHandle);
  inherited;
end;
function TPlugin.MyName:string;
begin
Result:=Copy(self.Info('name'),1,255);
end;
function TPlugins.IdNumber(id:string):integer;
 var i:integer;
begin
   i:= 0;
  while(i < Count) and (TPlugin(Get(i)).id <> id) do inc(i);
  If i = Count  then Result := -1 else result:=i;
 end;

function TPlugins.ById(id:string):TPlugin;
var i:integer;
begin
  i:= 0;
  while(i < Count) and (TPlugin(Get(i)).id <> id) do inc(i);
  If i = Count  then Result := nil else result:=TPlugin(Get(i));
end;
function TPlugins.GetName(Index:integer):string;
begin
  Result:=TPlugin(Get(Index)).name;
end;
function TPlugins.GetPlugin(Index:integer):TPlugin;
begin
  Result:=TPlugin(Get(Index));
end;
function TPlugins.NamesList:TStringList;
var Res:TStringList; i:integer;
begin
  Res:=TStringList.Create;
  for i:=1 to count do Res.Add('');
  for i:=1 to count do
     Res.Strings[i-1]:=GetName(i-1);
  Result:=Res;
end;

procedure TPlugins.LoadLib(FileIterator: TFileIterator);
var Plugin:TPlugin;
    Handle : TLibHandle;
    InfoProc:TInfoProc;
    EditProc:TEditProc;
    WorkProc:TWorkProc;
    lid:string;
begin
  Handle:=LoadLibrary(FileIterator.FileName);
  if Handle >=32 then
  begin
     @InfoProc:=GetProcAddress(Handle,'Info');
     @WorkProc:=GetProcAddress(Handle,'Work');
     @EditProc:=GetProcAddress(Handle,'Edit');
     if (@InfoProc<>nil) and (@EditProc<>nil) and (@WorkProc<>nil) then
     begin
        lid:=Copy(InfoProc('code'),1,255);//Иначе присваивается указатель, а не значение
        Plugin:=TPlugin.Create(lid,FileIterator.FileName,Handle);
        self.Add(Plugin);
     end else FreeLibrary(Handle);
  end
end;
Procedure TPlugins.LoadLibs;
var Worker:TFileSearcher;
begin
  Worker:=TFileSearcher.Create;
  Worker.OnFileFound:=self.LoadLib;
  Worker.Search('.\','dir*.dll');
  Worker.Free;
end;
destructor TPlugins.Destroy;
var i:integer;
begin
  for i:=1 to count do
    TPlugin(Get(i-1)).Free;
  inherited;
end;
procedure FileDoDll(OldD,OldF,NewD:string;ToDo:TTrans);
begin
   if ToDo.Action<>'ignore' then ForceDirectories(NewD+ExtractfileDir(OldF));
   Plugins.ById(ToDo.Action).Work(OldD+OldF,NewD+ExtractFileNameWithoutExt(OldF)+ToDo.ExTo,ToDo.Params);
end;
procedure FileDo(OldD,OldF,NewD,NewF,Act:string);
var AProcess:TProcess;
begin
  if Act<>'ignore' then
  begin
   ForceDirectories(NewD+ExtractfileDir(NewF));
   if Act='copy' then
    CopyFile(OldD+OldF,NewD+OldF,true)
    else
    begin
       AProcess := TProcess.Create(nil);
       AProcess.CommandLine:=StringReplace(Act,'%if%',OldD+OldF,[]);
       AProcess.CommandLine:=StringReplace(Aprocess.CommandLine,'%of%',NewD+NewF,[]);
//      AProcess.CommandLine:=ProgramDirectory+AProcess.CommandLine;
       AProcess.Execute;
       while AProcess.Running do
         sleep(10);
       AProcess.Free;
    end;
 end;
end;

  procedure Transform(DirFrom,DirTo:string;Files:TStringList);
  var i:integer;
     fil:string;
     tmp:string;
  begin
    Plugins:=TPlugins.Create;
    Plugins.LoadLibs;
    for i:=1 to files.Count do
    begin
      fil:= ExtractRelativePath(DirFrom,Files.Strings[i-1]);
      if Transl.IsExt(ExtractFileExt(fil)) then
      begin
         tmp:=Transl.Newfilename(fil,ExtractFileExt(fil));
         {$IFDEF DLL}
          FileDoDll(DirFrom,fil,DirTo,Transl.ExtTrans(ExtractFileExt(fil)));
          {$ELSE}
          FileDo(DirFrom,fil,DirTo,tmp,Transl.ExtTrans(ExtractFileExt(fil)).Action);
          {$ENDIF}
      end
      else
      begin
        if Transl.AddNew(ExtractFileExt(fil)) then
        begin
         // Mainform.lbTransList.Items:=transl.AsStringList;
          tmp:=Transl.Newfilename(fil,ExtractFileExt(fil));
          {$ifdef DLL}
          FileDoDll(DirFrom,fil,DirTo,Transl.ExtTrans(ExtractFileExt(fil)));
          {$else}
          FileDo(DirFrom,fil,DirTo,tmp,Transl.ExtTrans(ExtractFileExt(fil)).Action);
          {$endif}
        end;
      end;
    end;
    //Files.Free;
    plugins.Free;
  end;

  function TTransl.Isnull:boolean;
  begin
    Result:=(First=nil)
  end;
  Function TTransl.AddChk(ExFr:string):boolean;
  begin
    if not IsExt(ExFr) then
    begin
      Result:=AddNew(ExFr);
    end else Result:=True;
  end;
  procedure TTransl.SaveToIni(filename:string);
  var IniF:TIniFile;
      i:integer;
      cur:PTrans;
  begin
    IniF:=TIniFile.Create(filename);
       for i:=1 to Count do
    begin
      cur:=PTrans(Items[i-1]);
      IniF.WriteString(cur^.ExFr,'ExTo',cur^.ExTo);
      IniF.WriteString(cur^.ExFr,'Action',cur^.Action);
      IniF.WriteString(cur^.ExFr,'Params',cur^.Params);
    end;
    IniF.UpdateFile;
    IniF.Free;
  end;
  function TranslFromIni(filename:string):TTransl;
  var IniF:TIniFile;
      cur:Ptrans;
      Elist:TStringList;
      Res:TTransl;
      i:integer;
  begin
    IniF:=TIniFile.Create(filename);
    Res:=TTransl.Create;
    Elist:=TStringList.Create;
    IniF.ReadSections(Elist);
    for i:=0 to Elist.Count-1 do
    begin
      new(cur);
      cur^.ExFr:=Elist.Strings[i];
      cur^.ExTo:=iniF.ReadString(Elist.Strings[i],'ExTo','');
      cur^.Action:=iniF.ReadString(Elist.Strings[i],'Action','ignore');
      cur^.Params:=iniF.ReadString(Elist.Strings[i],'Params','');
      Res.Add(cur);
    end;
    Elist.Free;
    IniF.Free;
    Result:=res;
  end;
  destructor TTransl.Destroy;
  var i:integer;
  begin
     for i:=1 to count do
       Dispose(PTrans(Items[i-1]));
     inherited;
  end;
  function TTransl.Search(ExFr:string):PTrans;
  var cur:PTrans;
      i:integer;
  begin
  cur:=nil;
     for i:=1 to Count do
     begin
       if PTrans(Items[i-1])^.ExFr=ExFr then
       begin
         cur:=Items[i-1];
         break;
       end;
     end;
  result:=cur;
  end;
  function TTransl.Edit(ExFr:string):boolean;
  var cur:PTrans;
  begin
    cur:=Search(ExFr);
    {$ifdef DLL}
    if cur<>nil then Result:=EditDll(cur) else Result:=false;
    {$else}
    if cur<>nil then Result:=Edit_(cur) else Result:=false;
    {$endif}
  end;
  function TTransl.Edit_(tr:PTrans):boolean;
  begin
    if tr=nil then begin Result:=False; exit; end;
    Application.CreateForm(TTrEdForm, TrEdForm);
    //Передача редактируемых значений в форму
    TrEdForm.edFrom.Text:=tr^.ExFr;
    TrEdForm.edTo.Text:=tr^.ExTo;
    if (tr^.Action='ignore') or (tr^.Action='') then
    begin
       TrEdForm.rbIgnore.Checked:=true;
       TrEdForm.edAction.Text:='';
    end else
        if tr^.Action='copy' then
        begin
          TrEdForm.rbCopy.Checked:=true;
          TrEdForm.edAction.Text:='';
        end
        else
        begin
          TrEdForm.rbProcess.checked:=true;
          TrEdForm.edAction.Text:=tr^.Action;
        end;
     //Все передали
     if TrEdForm.ShowModal=mrOk then
     //Считывание
     begin
       tr^.ExFr:=TrEdForm.edFrom.Text;
       tr^.ExTo:=TrEdForm.edTo.Text;
       if TrEdForm.rbIgnore.Checked then tr^.Action:='ignore';
       if TrEdForm.rbCopy.Checked then tr^.Action:='copy';
       if TrEdForm.rbProcess.Checked then tr^.Action:=TrEdForm.edAction.Text;

       Result:= true;
     end
     else Result:=False;
     TrEdForm.Free;
  end;
  function TTransl.EditDll(tr:PTrans):boolean;
  var Num:integer;
  begin
    if tr=nil then begin Result:=False; exit; end;
    Application.CreateForm(TExtDlForm,ExtDlForm);
    //Передача редактируемых значений в форму
    ExtDlForm.edFrom.Text:=tr^.ExFr;
    ExtDlForm.edTo.Text:=tr^.ExTo;
    ExtDlForm.PluginParams:=tr^.Params;
    Num:=EdPlugins.IdNumber(tr^.Action);
    ExtDlForm.cbPlugins.ItemIndex:=EdPlugins.IdNumber(tr^.Action);
    if Num<>-1 then ExtDlForm.cbPlugins.Text:=EdPlugins[Num].Name;
    //Все передали
     if (ExtDlForm.ShowModal=mrOk) and (ExtDlForm.cbPlugins.ItemIndex<>-1) then
     //Считывание
     begin
       tr^.ExFr:=ExtDlForm.edFrom.Text;
       tr^.ExTo:=ExtDlForm.edTo.Text;
       tr^.Action:=EdPlugins[ExtDlForm.cbPlugins.ItemIndex].id;
       tr^.Params:=ExtDlForm.PluginParams;
       Result:= true;
     end
     else Result:=False;
    ExtDlForm.Free;
  end;

  function TTransl.AsStringList:TStringList;
  var Res:TStringList;
      cur:PTrans;
      i:integer;
  begin
    Res:=TStringList.Create;
    for i:=1 to Count do
    begin
      cur:=PTrans(Items[i-1]);
      if cur^.Action='ignore' then
        Res.Add(cur^.ExFr+' ignore')
      else if cur^.Action='copy' then
        Res.Add(cur^.ExFr+' copy')
      else Res.Add(cur^.ExFr+' ==> '+cur^.ExTo);
    end;
    Result:=Res;
  end;

  function TTransl.ExtTrans(ExFr:string): TTrans;
  var cur:PTrans;
  begin
    cur:=Search(ExFr);
    Result:=cur^;
  end;
  function TTransl.Newfilename(filename,ext:string):string;
  begin
    Result:=ExtractFileNameWithoutExt(filename)+Search(ext)^.ExTo;
  end;
  function TTransl.AddNew(ExFr:string):boolean;
  var aPTrans:PTrans;
  begin
    // Поиск входного расширения; Если есть -ошибка
    if Search(ExFr)<>nil then
       Application.MessageBox(PChar('Попытка повторного добавления расширения '+ExFr),'Ошибка',MB_OK);
    New(aPTrans);
    //Закинуть разрешение и открыть
    aPTrans^.ExFr:=ExFr;
    //Для болванки закидываем назначение равным исходному
    aPTrans^.ExTo:=ExFr;
    Transl.Add(aPTrans);
    {$ifdef DLL}
    if not EditDll(aPTrans) then
    {$else}
    if not Edit_(aPTrans) then
    {$endif}
    begin
      Delete_(aPTrans);
      Result:=false;
    end else  Result:=True;
  end;
  Procedure TTransl.Delete_(P:Ptrans);
  begin
    Dispose(P);
    clear;
  end;
  function TTransl.IsExt(ExFr:string):boolean;
  begin
  Result:=Search(ExFr)<>nil;
  end;


end.