unit ExtDevIntu;{external devices interface unit, for any
(not known by Chromulan) devices using third party DLLs}
interface
uses
  Windows, SysUtils, Classes, UlanType, DllUtl, WinUtl{v0.65}, ExeLogu{/v0.65};

{v0.14}(*/v0.14
function ExtDevInit(var AExtDevDrv: PExtDevDrv; const ADesc: shortstring): integer;
function ExtDevStart(AExtDevDrv: PExtDevDrv): integer;
function ExtDevDoCharIn(AExtDevDrv: PExtDevDrv; ch:char): integer;
function ExtDevReadPoint(AExtDevDrv: PExtDevDrv; var AExpPoint: TExpPoint): integer;
function ExtDevStop(AExtDevDrv: PExtDevDrv): integer;
function ExtDevDone(var AExtDevDrv: PExtDevDrv): integer;

function ExtDevPresent(const ADesc:shortstring): boolean;
  { Looks for DLL that have exported the above methods,
    loads all methods, returns true if all found. Also returns
    true if already loaded.
    If ADesc is '', then looks for ALL DLLs in application exe dir,
    otherwise just for DLL that has name equal to the first word of ADesc }
*)
{v0.31}
const
  { Subdir of exedir where device DLLs should reside. Nevertheless the exedir
    is searched first for the presence of DLL if specified by its name.
    At startup only DevDir is searched for DLL names, then the DLLs get loaded,
    but if a DLL of the same name as in DevDir is present in exedir, than
    the one in exedir will be loaded. }
  DevDir: string = 'dev\';
{/v0.31}

{v0.14}
type
  {v0.65}
  TExtDevSetStr = function(AExtDevDrv: PExtDevDrv; ep: TExtDevProperty;
    const S: shortstring):integer;
  TExtDevGetStr = function (AExtDevDrv: PExtDevDrv; ep: TExtDevProperty;
    var S: shortstring):integer;
  {/v0.65}

  EExtDev = class(Exception);
  TExtDev = class(TObject)
  private
    FHandle: THandle;
    {v0.65}{/v0.65 FDesc: shortstring;}
    FExtDevDrvName: string;
    FExtDevDrv: PExtDevDrv;
    {v0.65}
    FName: string; // if non empty, then in one device DLL is support for more devices
    {/v0.65}
    {mandatory interface:}
    FExtDevInit: function(var AExtDevDrv: PExtDevDrv; const ADesc: shortstring): integer;
    FExtDevStart: function(AExtDevDrv: PExtDevDrv): integer;
    FExtDevDoCharIn: function(AExtDevDrv: PExtDevDrv; ch:char): integer;
    FExtDevReadPoint: function(AExtDevDrv: PExtDevDrv; var AExpPoint: TExpPoint): integer;
    FExtDevStop: function(AExtDevDrv: PExtDevDrv): integer;
    FExtDevDone: function(var AExtDevDrv: PExtDevDrv): integer;
    {/mandatory interface}
    {v0.21}
    FExtDevDoAction: function(AExtDevDrv: PExtDevDrv; ea: TExtDevAction; AInfo: longint): integer;
    {/v0.21}
    {v0.65}
    FExtDevGetStr: TExtDevGetStr;
    FExtDevSetStr: TExtDevSetStr;
    {/v0.65}
    FTemplateExists: boolean;
    {v0.65}
    function GetDeviceName: string;
      // returns name of dll driver eventually with name of the device supported
      // by the dll (separated by dot)
    procedure SetName(const AName: string);
    {/v0.65}
  protected
    function LoadMethods: boolean;
    procedure Unload;
  public
     { AExtDevDrvName must be without any  path or extension, it
       is a name of the DLL located in directory DevDir (or exedir). The name
       can be followed by a devicename (separated by dot), if the DLL supports
       more devices. }
    constructor Create(const AExtDevDrvName: string);reintroduce;
    destructor Destroy;override;
    function Init{v0.65}{/v0.65 (const ADesc: shortstring)}: integer;
    function Done: integer;
    function Start: integer;
    function DoCharIn(ch: char): integer;
    function Stop: integer;
    function ReadPoint(var AExpPoint: TExpPoint): integer;
    {v0.21}
    function DoAction(ea: TExtDevAction; AInfo: longint): integer;
    {/v0.21}
    {v0.65}
    function GetStr(ep: TExtDevProperty; var s: shortstring): integer;
    function SetStr(ep: TExtDevProperty; const s: shortstring): integer;
    {/v0.65}

    property ExtDevDrvName: string read FExtDevDrvName;
    property TemplateExists: boolean read FTemplateExists write FTemplateExists;
    {v0.65}
    property Name: string read FName write SetName;
    property DeviceName: string read GetDeviceName;
    property ExtDevGetStr: TExtDevGetStr read FExtDevGetStr;
    property ExtDevSetStr: TExtDevSetStr read FExtDevSetStr;
    {/v0.65}
  end;

  TExtDevs = class(TList)
    constructor Create;reintroduce;
    procedure ExtDevsLoad;
    procedure Clear;override;
    destructor Destroy;override;
    function AddExtDev(const AExtDevDrvName: string): TExtDev;
      { returns non nil if added (i.e. dll found and loaded ok);
        AExtDevDrvName must be without any  path or extension }
    function FindDev(const {v0.65}ADeviceName {/v0.65 AExtDevDrvName}: string): TExtDev;
      { returns non nil if found; AExtDevDrvName must be without any
        path or extension; eventually can contain dot separated name of the device
        if more than one supported }
    procedure TemplateRegister(const AFileName: string);
  end;

const
  ExtDevs: TExtDevs = nil;
    { Names of DLLs (without extensions) - ext dev drivers found upon program startup
      in Exe dir. }
{/v0.14}

implementation

{
const
  DLLHandle: THandle = 0;

const
  FExtDevInit: function(var AExtDevDrv: PExtDevDrv; const ADesc: shortstring): integer = nil;
  FExtDevStart: function(AExtDevDrv: PExtDevDrv): integer = nil;
  FExtDevDoCharIn: function(AExtDevDrv: PExtDevDrv; ch:char): integer = nil;
  FExtDevReadPoint: function(AExtDevDrv: PExtDevDrv; var AExpPoint: TExpPoint): integer = nil;
  FExtDevStop: function(AExtDevDrv: PExtDevDrv): integer = nil;
  FExtDevDone: function(var AExtDevDrv: PExtDevDrv): integer = nil;

procedure Unload(var ADLLHandle: THandle);
begin
  FExtDevInit:= nil;
  FExtDevStart:= nil;
  FExtDevDoCharIn:= nil;
  FExtDevReadPoint:= nil;
  FExtDevStop:= nil;
  FExtDevDone:= nil;
  if ADLLHandle = 0 then
    exit;
  DLLFree(ADLLHandle);
end;

function LoadMethods(ADLLHandle: THandle): boolean;
label er;
begin
  Result := false;
  if not DLLAssignProc(@FExtDevInit, ADLLHandle, 'ExtDevInit', false) then
    goto er;
  if not DLLAssignProc(@FExtDevStart, ADLLHandle, 'ExtDevStart', false) then
    goto er;
  if not DLLAssignProc(@FExtDevDoCharIn, ADLLHandle, 'ExtDevDoCharIn', false) then
    goto er;
  if not DLLAssignProc(@FExtDevReadPoint, ADLLHandle, 'ExtDevReadPoint', false) then
    goto er;
  if not DLLAssignProc(@FExtDevStop, ADLLHandle, 'ExtDevStop', false) then
    goto er;
  if not DLLAssignProc(@FExtDevDone, ADLLHandle, 'ExtDevDone', false) then
    goto er;
  Result := true;
  exit;
er:
  Unload(ADLLHandle);
end;

function ExtDevPresent(const ADesc:shortstring): boolean;
var
  mask:string;
  f:TSearchRec;
  r:integer;
begin
  if DLLHandle <> 0 then begin
    Result := true;
  end else begin
    Result := false;

    if ADesc = '' then begin
      mask := '*.DLL'
    end else begin
      mask := ADesc + '.DLL';
    end;

    try
      r := FindFirst(ExtractFilePath(Paramstr(0)) + mask, faAnyFile, f);
      if r = 0 then begin
        if DLLLoad(f.Name, false, DLLHandle) then begin
          Result := LoadMethods(DLLHandle);
        end;
      end;
    finally
      FindClose(f);
    end;
  end;
end;

function ExtDevInit(var AExtDevDrv: PExtDevDrv; const ADesc: shortstring): integer;
begin
  Result := -1;
  if Assigned(FExtDevInit) then
    Result := FExtDevInit(AExtDevDrv, ADesc);
end;

function ExtDevStart(AExtDevDrv: PExtDevDrv): integer;
begin
  Result := -1;
  if Assigned(FExtDevStart) then
    Result := FExtDevStart(AExtDevDrv);
end;

function ExtDevDoCharIn(AExtDevDrv: PExtDevDrv; ch:char): integer;
begin
  Result := -1;
  if Assigned(FExtDevDoCharIn) then
    Result := FExtDevDoCharIn(AExtDevDrv, ch);
end;

function ExtDevReadPoint(AExtDevDrv: PExtDevDrv; var AExpPoint: TExpPoint): integer;
begin
  Result := -1;
  if Assigned(FExtDevReadPoint) then
    Result := FExtDevReadPoint(AExtDevDrv, AExpPoint);
end;

function ExtDevStop(AExtDevDrv: PExtDevDrv): integer;
begin
  Result := -1;
  if Assigned(FExtDevStop) then
    Result := FExtDevStop(AExtDevDrv);
end;

function ExtDevDone(var AExtDevDrv: PExtDevDrv): integer;
begin
  Result := -1;
  if Assigned(FExtDevDone) then
    Result := FExtDevDone(AExtDevDrv);
end;
}

{TExtDev}
constructor TExtDev.Create(const AExtDevDrvName: string);
{v0.65}
var
  dllName, devName, fn: string;
  i: integer;
{/v0.65}
begin
  {v0.65}
  i := pos('.', AExtDevDrvName);
  if i > 0 then begin
    dllName := copy(AExtDevDrvName, 1, i - 1);
    devName := copy(AExtDevDrvName, i + 1, length(AExtDevDrvName));
  end else begin
    devName := '';
    dllName := AExtDevDrvName;
  end;
  {/v0.65}
  fn := FileSearch(dllName + '.dll', DevDir + ';ExtDev');// extdev - for modules in development
  if DLLLoad({v0.65}fn{/v0.65 DevDir + AExtDevDrvName}, false, FHandle) then begin
    if not LoadMethods then begin
      raise EExtDev.Create('Invalid DLL');
    end;
    FExtDevDrvName := {/v0.65}dllName {v0.65 AExtDevDrvName};
    {v0.65}
    FName := devName;
    ExeLog.Log('ExtDev DLL loaded: ' + fn + ' Device: ' + devName);
    {/v0.65}
  end else begin
    raise EExtDev.Create('DLL Load failed.' + {v0.65}fn{/v0.65 DevDir + dllName});
  end;
end;

destructor TExtDev.Destroy;
begin
  if FHandle <> 0 then begin
    Stop;
    Done;
  end;
  Unload;
  inherited;
end;

procedure TExtDev.Unload;
begin
  FExtDevInit:= nil;
  FExtDevStart:= nil;
  FExtDevDoCharIn:= nil;
  FExtDevReadPoint:= nil;
  FExtDevStop:= nil;
  FExtDevDone:= nil;
  {v0.21}
  FExtDevDoAction:= nil;
  {/v0.21}
  {v0.65}
  FExtDevGetStr := nil;
  FExtDevSetStr := nil;
  {/v0.65}
  if FHandle = 0 then
    exit;
  DLLFree(FHandle);
end;

function TExtDev.LoadMethods: boolean;
label er;
begin
  Result := false;
  if not DLLAssignProc(@FExtDevInit, FHandle, 'ExtDevInit', false) then
    goto er;
  if not DLLAssignProc(@FExtDevStart, FHandle, 'ExtDevStart', false) then
    goto er;
  if not DLLAssignProc(@FExtDevDoCharIn, FHandle, 'ExtDevDoCharIn', false) then
    goto er;
  if not DLLAssignProc(@FExtDevReadPoint, FHandle, 'ExtDevReadPoint', false) then
    goto er;
  if not DLLAssignProc(@FExtDevStop, FHandle, 'ExtDevStop', false) then
    goto er;
  if not DLLAssignProc(@FExtDevDone, FHandle, 'ExtDevDone', false) then
    goto er;

  {v0.21}
  if not DLLAssignProc(@FExtDevDoAction, FHandle, 'ExtDevDoAction', false) then
    FExtDevDoAction := nil;
  {/v0.21}
  {v0.65}
  if not DLLAssignProc(@FExtDevGetStr, FHandle, 'ExtDevGetStr', false) then
    FExtDevGetStr := nil;
  if not DLLAssignProc(@FExtDevSetStr, FHandle, 'ExtDevSetStr', false) then
    FExtDevSetStr := nil;
  {/v0.65}

  Result := true;
  exit;
er:
  Unload;
end;

{v0.65}
function TExtDev.Init: integer;
begin
  Result := -1;
  if Assigned(FExtDevInit) then
    Result := FExtDevInit(FExtDevDrv, Name);
end;
{/v0.65
function TExtDev.Init(const ADesc: shortstring): integer;
begin
  Result := -1;
  FDesc := ADesc;
  if Assigned(FExtDevInit) then
    Result := FExtDevInit(FExtDevDrv, FDesc);
end;
}

function TExtDev.Start: integer;
begin
  Result := -1;
  if Assigned(FExtDevStart) then
    Result := FExtDevStart(FExtDevDrv);
end;

function TExtDev.DoCharIn(ch:char): integer;
begin
  Result := -1;
  if Assigned(FExtDevDoCharIn) then
    Result := FExtDevDoCharIn(FExtDevDrv, ch);
end;

function TExtDev.ReadPoint(var AExpPoint: TExpPoint): integer;
begin
  Result := -1;
  if Assigned(FExtDevReadPoint) then
    Result := FExtDevReadPoint(FExtDevDrv, AExpPoint);
end;

function TExtDev.Stop: integer;
begin
  Result := -1;
  if Assigned(FExtDevStop) then
    Result := FExtDevStop(FExtDevDrv);
end;

function TExtDev.Done: integer;
begin
  Result := -1;
  if Assigned(FExtDevDone) then
    Result := FExtDevDone(FExtDevDrv);
end;

{v0.21}
function TExtDev.DoAction(ea: TExtDevAction; AInfo: longint): integer;
begin
  Result := -1;
  if Assigned(FExtDevDoAction) then
    Result := FExtDevDoAction(FExtDevDrv, ea, AInfo);
end;
{/v0.21}

{v0.65}

{v0.65}
function TExtDev.GetStr(ep: TExtDevProperty; var s: shortstring): integer;
begin
  Result := edrProcNotPresent;
  if Assigned(FExtDevGetStr) then
    Result := FExtDevGetStr(FExtDevDrv, ep, s);
end;

function TExtDev.SetStr(ep: TExtDevProperty; const s: shortstring): integer;
begin
  Result := edrProcNotPresent;
  if Assigned(FExtDevSetStr) then
    Result := FExtDevSetStr(FExtDevDrv, ep, s);
end;
{/v0.65}

function TExtDev.GetDeviceName: string;
begin
  if FName <> '' then begin
    Result := FExtDevDrvName + '.' + FName;
  end else begin
    Result := FExtDevDrvName;
  end;
end;

procedure TExtDev.SetName(const AName: string);
begin
  if FName <> AName then begin
    if AName = '' then
      FName := FExtDevDrvName
    else
      FName := AName;
    ExeLog.Log('ExtDev.' + ExtDevDrvName + ' Device name set to: ' + AName);
  end;
end;
{/v0.65}
{/TExtDev.}

{TExtDevs}
constructor TExtDevs.Create;
begin
  inherited Create;
  ExtDevsLoad;
end;

procedure TExtDevs.ExtDevsLoad;
var
  mask: string;
  f: TSearchRec;
  r: integer;
  i: integer;
  dirs:array[0..1] of string;
begin
  dirs[0] := DevDir; dirs[1] := 'ExtDev\'; // extdev - development directory
  Clear;
  mask := '*.DLL';
  for i := 0 to 1 do begin
     CreateDir(ExtractFilePath(Paramstr(0)) + dirs[i]);
    try
      r := FindFirst(ExtractFilePath(Paramstr(0))+ dirs[i] + mask, faAnyFile, f);
      {v0.22}
      while r = 0 do begin
      {/v0.22
      if r = 0 then begin}
        AddExtDev(ChangeFileExt(f.Name, ''));

        {if DLLLoad(f.Name, false, DLLHandle) then begin
          if LoadMethods(DLLHandle) then begin
            ExtDevs.AddExtDev(ChangeFileExt(f.Name, ''));
            Unload(DLLHandle);
          end;
        end;}
        {v0.22}
        r := FindNext(f);
        {/v0.22}
      end;
    finally
      FindClose(f);
    end;
  end;
end;

procedure TExtDevs.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    TExtDev(Items[i]).Free;
  inherited Clear;
end;

function TExtDevs.AddExtDev(const AExtDevDrvName: string): TExtDev;
var
  ed: TExtDev;
  s, w: string;
  lst: shortstring;
  i: integer;
begin
  Result := nil;
  try
    ed := TExtDev.Create(AExtDevDrvName);
    Add(ed);
    {v0.65}
    if Assigned(ed.ExtDevGetStr) then begin
      lst := '';
      ed.ExtDevGetStr(nil, epDeviceList, lst);
      s := lst;
      if s <> '' then begin
        { more devices supported by AExtDevDrvName driver, create TExtDev
          instance for each of them: }
        i := 0;
        while ExtractWord([',', ' '], w, s) do begin
          if i = 0 then begin
            ed.Name := w;
          end else begin
            ed := TExtDev.Create(AExtDevDrvName + '.' + w);
            Add(ed);
            //ed.Name := w;
          end;             //classes
          inc(i);
        end;
      end;
    end;
    {/v0.65}
    Result := ed;
  except
  end;
end;

function TExtDevs.FindDev(const {v0.65}ADeviceName{/v0.65 AExtDevDrvName}: string): TExtDev;
var i: integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do begin
    if TExtDev(Items[i]).{v0.65}DeviceName{/v0.65 ExtDevDrvName} = {v0.65}ADeviceName
    {/v0.65 AExtDevDrvName} then
    begin
      Result := TExtDev(Items[i]);
      exit;
    end;
  end;
end;

destructor TExtDevs.Destroy;
begin
  Clear;
  inherited;
end;

procedure TExtDevs.TemplateRegister(const AFileName: string);
var
  n: string;
  e: TExtDev;
begin
  n := ChangeFileExt(AFileName, '');
  e := FindDev(n);
  if e <> nil then
    e.TemplateExists := true;
end;

{/TExtDevs}

  {v0.14}{/v0.14 finalization Unload(DLLHandle);}
end.
