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

{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.14}
type
  EExtDev = class(Exception);
  TExtDev = class(TObject)
  private
    FHandle: THandle;
    FDesc: shortstring;
    FExtDevDrvName: string;
    FExtDevDrv: PExtDevDrv;
    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;
    FTemplateExists: boolean;
  protected
    function LoadMethods: boolean;
    procedure Unload;
  public
    constructor Create(const AExtDevDrvName: string);reintroduce;
     { AExtDevDrvName must be without any  path or extension, it
       is name of the DLL located in EXE dir }
    destructor Destroy;override;
    function Init(const ADesc: shortstring): integer;
    function Done: integer;
    function Start: integer;
    function DoCharIn(ch: char): integer;
    function Stop: integer;
    function ReadPoint(var AExpPoint: TExpPoint): integer;
    property ExtDevDrvName: string read FExtDevDrvName;
    property TemplateExists: boolean read FTemplateExists write FTemplateExists;
  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 AExtDevDrvName: string): TExtDev;
      { returns non nil if found; AExtDevDrvName must be without any
        path or extension  }
    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);
begin
  if DLLLoad(AExtDevDrvName, false, FHandle) then begin
    if not LoadMethods then begin
      raise EExtDev.Create('Invalid DLL');
    end;
    FExtDevDrvName := AExtDevDrvName;
  end else begin
    raise EExtDev.Create('DLL Load failed.');
  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;
  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;
  Result := true;
  exit;
er:
  Unload;
end;

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;
{/TExtDev}

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

procedure TExtDevs.ExtDevsLoad;
var
  mask: string;
  f: TSearchRec;
  r: integer;
begin
  Clear;
  mask := '*.DLL';
  try
    r := FindFirst(ExtractFilePath(Paramstr(0)) + mask, faAnyFile, f);
    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;}
    end;
  finally
    FindClose(f);
  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;
begin
  Result := nil;
  try
    ed := TExtDev.Create(AExtDevDrvName);
    Add(ed);
    Result := ed;
  except
  end;
end;

function TExtDevs.FindDev(const AExtDevDrvName: string): TExtDev;
var i: integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do begin
    if TExtDev(Items[i]).ExtDevDrvName = 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.
