unit ULScript3u;
{v0.78 Derived from ifps3\ide-demo\ide_editor.pas but instead of form
  using datamodule. }

interface

uses
  Windows, SysUtils, Classes, Forms,
  TypInfo,
  ifps3, ifps3disasm, ifps3debug,
  IFPS3CompExec, ifps3CEImp_StdCtrls, ifps3CEImp_Forms,
  ifps3CEImp_Default, ifps3CEImp_Controls, Dialogs,

  PropUtl, ExeLogu, ULObjUsru, ULObju,
  UlanGlob, ULScriptType
  ;

const
  ENoError = ErNoError;
const
  IFSExt = '.IFS';

type
  TOnWriteln = procedure(s: string);
  TLogProc = procedure(s: string);

  TULScript = class(TDataModule)
    IFPS3DllPlugin1: TIFPS3DllPlugin;
    IFPS3CE_Controls1: TIFPS3CE_Controls;
    IFPS3CE_DateUtils1: TIFPS3CE_DateUtils;
    IFPS3CE_Std1: TIFPS3CE_Std;
    IFPS3CE_Forms1: TIFPS3CE_Forms;
    IFPS3CE_StdCtrls1: TIFPS3CE_StdCtrls;
    CompExec: TIFPS3DebugCompExec;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure CompExecAfterExecute(Sender: TIFPS3CompExec);
    procedure CompExecCompile(Sender: TIFPS3CompExec);
    procedure CompExecExecute(Sender: TIFPS3CompExec);
    procedure CompExecIdle(Sender: TObject);
    procedure CompExecLineInfo(Sender: TObject; Position, Row,
      Col: Cardinal);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    FResume: Boolean;
    FActiveLine: integer;
    FMessages: TStrings;
    FScriptLines: TStrings;
    FFileScriptLines: TStrings;
    FFileName: string;
    FCommandLine: string;
    FLogProc: TLogProc;
    FUsr: TObject;

    FAfterExecute: TIFPS3CompExecEvent;
    FOnCompile: TIFPS3CompExecEvent;
    FOnExecute: TIFPS3CompExecEvent;
    FOnIdle: TNotifyEvent;
    FOnOpen: TNotifyEvent;

    FOnWriteln: TOnWriteln;
    FOnMessageAdd: TOnWriteln;
    FOnNew: TNotifyEvent;
    FOnLoadFromFile: TNotifyEvent;
    FOnSaveToFile: TNotifyEvent;

    function GetMessages: TStrings;
    function GetScriptLines: TStrings;

    {EXPORT}
    procedure readln(var s: string);
    procedure writeln(s: string);
    function ParamCount: integer;
    function ParamStr(i:integer): string;
    {/EXPORT}
    function GetNextParam(var ACommandLine: string; var AParam: string): boolean;
    function ULObjFindPropInfo(const AObjPath: string; const APropName: string; var AObject: TObject; var APropInfo: PPropInfo): boolean;
    { Set value to device property in internal/user units }
    function DevSetStrX(const ADeviceAlias: string; const ADeviceProp: string; const AValue: string; InUserUnits: boolean): boolean;
    { Get value of device property in internal/user units }
    function DevGetStrX(const ADeviceAlias: string; const ADeviceProp: string; InUserUnits: boolean): string;


    procedure MessageAdd(s: string);
    { Check if ScriptLines were modified by direct assignment since
      last load from/save to file. }
    function SaveCheck: Boolean;
    function GetModified: boolean;
    function GetFileScriptLines: TStrings;
    function GetErrorCode: TIFError;
    function GetErrorMsg: string;
    function GetErrorPos: integer;
    procedure RunError(er: TIFError);
    procedure RunError2(er: TIFError; s: string);
    function GetScriptsDirList: string;

  public
    { Public declarations }
    {variables}
    {/variables}
    {methods}
    { RunScript runs the script with source stored in ScriptLines.
      The ScriptLines should be filled by calling Open or LoadFromFile
      or by assigning to the CommandLine property. }
    function RunScript: boolean;
    { Clear ScriptLines, fills it with create test program lines.
      Expecting assignment of new script by one of the following:
        - calling Open
        - calling LoadFromFile
        - assigning to CommandLine }
    procedure New;
    { Calls open file dialog to choose a script file to be loaded. }
    procedure Open;
    { Loads script to ScriptLines and FileScriptLiens from the specified
      file. Called by Open. }
    procedure LoadFromFile(const AFileName: string);
    { Method called by Save and SaveAs methods to actually store
      the ScriptLines to the AFileName. }
    procedure SaveToFile(const AFileName: string);
    { Save ScriptLines to the file specified during the last LoadFromFile.
      If no previous filename assigned SaveAs method is called. }
    procedure Save;
    { Invokes SaveFile dialog, saves to the selecte filename. }
    procedure SaveAs;
    { Assign script source directly to the ScriptLines. FileScriptLines
      leaves unchanged. }
    procedure SetText(s: string);
    { Set/Reset breakpoint at given source Line number }
    procedure ToggleBreakPoint(Line: integer);
    { Debug - step into }
    procedure StepInto;
    { Debug - step over }
    procedure StepOver;
    { Compile the script stored in ScriptLines. Called from RunScript before Execute. }
    function Compile: boolean;
    { Execute the compiled script. Called from RunScript if Compile succeeded. }
    function Execute: Boolean;
    { Stop the script. }
    procedure Reset;
    { Synonym to Reset - stop the script. }
    procedure Abort;
    { Clear all variables. }
    procedure Cleanup;

    procedure Decompile(var ALines: TStrings);

    { Load the script from the file specified as the first word of the command
      line string (specified without the file extension), use any following
      words in the commandline as parameters for  the script. }
    procedure RunCommandLine(const ACommandLine: string);
    { Load source of the script from the file specified as the first word in
      the CommandLine. }

    procedure LoadFromCommandLine;
    procedure Log(const msg: string);



    function FindChannel(var AChannel: TObject): boolean;
    function FindProcessor(var AProcessor: TObject): boolean;
    function FindSeqPrg(var ASeqPrg: TObject): boolean;

    {EXPORT}
    { Set AValue to the property APropName of object specified by AObjPath
      (absolute ULObjPath). }
    function ObjSetStr(const AObjPath: string; const APropName: string; const AValue: string): boolean;
    { Get value of the property APropName of the object specified by AObjPath. }
    function ObjGetStr(const AObjPath: string; const APropName: string): string;
    { Set value to device property in internal units. }
    function DevSetStr(const ADeviceAlias: string; const ADeviceProp: string; const AValue: string): boolean;
    { Get value of device property in internal units }
    function DevGetStr(const ADeviceAlias: string; const ADeviceProp: string): string;
    { Get absolute ULObjPath for specified ADeviceAlias. }
    function GetDevicePath(const ADeviceAlias: string): string;
    { Get absolute ULObjPath of current ActiveXXXX object specified in
      AULObjAliasPath (see ULScriptType paXXXX for supported 'ActiveXXXX' values). }
    function GetCurPath(const AULObjAliasPath: string): string;
    { Sending program lines to device. See unit SeqPrgDevu (AParam is name of the
      device to send the lines in). }
    procedure PrgToDev(const ADeviceAlias: string; const AParam: string);
    { Set value to device property in user units }
    function DevSetStrU(const ADeviceAlias: string; const ADeviceProp: string; const AValue: string): boolean;
    { Get value of device property in user units }
    function DevGetStrU(const ADeviceAlias: string; const ADeviceProp: string): string;
    {/EXPORT}
    {/methods}

    {properties}
    { Were ScriptLines modified since last New, SaveToFile or LoadFromFile? }
    property Modified: boolean read GetModified;
    { Messages collected during the last script run }
    property Messages: TStrings read GetMessages;
    { Source lines of the script to be run }
    property ScriptLines: TStrings read GetScriptLines;
    property FileName: string read FFileName;
    property CommandLine: string read FCommandLine write FCommandLine;

    property FileScriptLines: TStrings read GetFileScriptLines;
    property ErrorCode: TIFError read GetErrorCode;
    property ErrorMsg: string read GetErrorMsg;
    property ErrorPos: integer read GetErrorPos;
    property ScriptsDirList: string read GetScriptsDirList;
    property Usr: TObject read FUsr write FUsr;
    {/properties}

    {events}
    property AfterExecute: TIFPS3CompExecEvent read FAfterExecute write FAfterExecute;
    property OnCompile: TIFPS3CompExecEvent read FOnCompile write FOnCompile;
    property OnExecute: TIFPS3CompExecEvent read FOnExecute write FOnExecute;
    property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
    property LogProc: TLogProc read FLogProc write FLogProc;

    { When script calles writeln pascal procedure. }
    property OnWriteln: TOnWriteln read FOnWriteln write FOnWriteln;
    { When compiler/executor message added }
    property OnMessageAdd: TOnWriteln read FOnMessageAdd write FOnMessageAdd;
    { When New method called. }
    property OnNew: TNotifyEvent read FOnNew write FOnNew;
    { When new script loaded from file. }
    property OnLoadFromFile: TNotifyEvent read FOnLoadFromFile write FOnLoadFromFile;
    property OnSaveToFile: TNotifyEvent read FOnSaveToFile write FOnSaveToFile;
    {/events}
  end;

function ScriptsDir: string;
  
var
  ULScript: TULScript;


implementation
uses
  SeqPrgu, Processoru, SeqPrgToDevu,
  ULDPType, Channelsu,
  ULIType, ULIObju;

{$R *.dfm}
const
  FScriptsDir: string = '';

function ScriptsDir: string;
begin
  if FScriptsDir = '' then
    Result := DataDir + 'Scripts\'
  else
    Result := FScriptsDir;
end;

{private methods}
function TULScript.GetMessages: TStrings;
begin
  if FMessages = nil then
    FMessages := TStringList.Create;
  Result := FMessages;
end;

function TULScript.GetScriptLines: TStrings;
begin
  if FScriptLines = nil then
    FScriptLines := TStringList.Create;
  Result := FScriptLines;
end;

function TULScript.GetFileScriptLines: TStrings;
begin
  if FFileScriptLines = nil then
    FFileScriptLines := TStringList.Create;
  Result := FFileScriptLines;
end;

procedure TULScript.writeln(s: string);
begin
  if Assigned(FOnWriteln) then
    FOnWriteln(s);
{
  debugoutput.output.Lines.Add(S);
  debugoutput.Visible := True;
}
end;

procedure TULScript.readln(var s: string);
begin
  s := InputBox('Script', '', '');
end;

procedure TULScript.MessageAdd(s: string);
begin
  if Assigned(FOnMessageAdd) then
    FOnMessageAdd(s);
  Messages.Add(s);
end;

function TULScript.SaveCheck: Boolean;
begin
  if Modified then begin
    case MessageDlg('Script has not been saved, save now?', mtConfirmation, mbYesNoCancel, 0) of
      idYes: begin
        Save;
        Result := FFileName <> '';
      end;
      IDNO: begin
        Result := True;
      end;
    else
      Result := False;
    end;
  end else begin
    Result := True;
  end;
end;

function TULScript.GetModified: boolean;
begin
  Result := ScriptLines.Text <> FileScriptLines.Text;
end;
{/private methods TULScript3.}

{public methods}
function TULScript.RunScript: boolean;
begin
  if CompExec.Running then begin
    FResume := true;
    Result := true;
  end else begin
    if Compile then begin
      Result := Execute;
    end else begin
      Result := false;//RunError
    end;
  end;
end;

procedure TULScript.ToggleBreakPoint(Line: integer);
begin
  if CompExec.HasBreakPoint(Line) then
    CompExec.ClearBreakPoint(Line)
  else
    CompExec.SetBreakPoint(Line);
end;

procedure TULScript.StepOver;
begin
  if CompExec.Exec.Status = isRunning then begin
    CompExec.StepOver
  end else begin
    if Compile then begin
      CompExec.StepInto;
      Execute;
    end;
  end;
end;

procedure TULScript.StepInto;
begin
  if CompExec.Exec.Status = isRunning then begin
    CompExec.StepInto
  end else begin
    if Compile then begin
      CompExec.StepInto;
      Execute;
    end;
  end;
end;

function TULScript.Compile: Boolean;
var
  i: Longint;
begin
  CompExec.Script.Assign(ScriptLines);
  Result := CompExec.Compile;
  Messages.Clear;
  for i := 0 to CompExec.CompilerMessageCount -1 do
  begin
    MessageAdd(CompExec.CompilerMessages[i].MessageToString);
  end;
  if Result then
    MessageAdd('Succesfully compiled');
end;

procedure TULScript.Reset;
begin
  if CompExec.Exec.Status = isRunning then
    CompExec.Stop;
end;

procedure TULScript.Abort;
begin
  Reset;
end;


function TULScript.Execute: Boolean;
begin
//  debugoutput.Output.Clear;
  if CompExec.Execute then begin
    MessageAdd('Succesfully Executed');
    Result := True;
  end else begin
    MessageAdd('Runtime Error: '+ CompExec.ExecErrorToString +
      ' at ['+IntToStr(CompExec.ExecErrorRow)+':'+
        IntToStr(CompExec.ExecErrorCol)+'] bytecode pos:'+
        inttostr(CompExec.ExecErrorProcNo)+':'+
        inttostr(CompExec.ExecErrorByteCodePosition));
    Result := False;
  end;
end;

procedure TULScript.New;
begin
  if SaveCheck then
  begin
    FFileName := '';
    ScriptLines.Text := 'Program test;'#13#10'begin'#13#10'end.';
    FileScriptLines.Text := ScriptLines.Text;
    //ed.ClearAll;
    //ed.Modified := False;
    if Assigned(FOnNew) then
      FOnNew(Self);
  end;
end;

procedure TULScript.Open;
begin
  if SaveCheck then begin
    if OpenDialog1.Execute then
    begin
      LoadFromFile(OpenDialog1.FileName);
    end;
  end;
end;

procedure TULScript.SetText(s: string);
begin
  ScriptLines.Text := s;
end;

procedure TULScript.LoadFromFile(const AFileName: string);
begin
  ScriptLines.Clear;
  ScriptLines.LoadFromFile(AFileName);
  FileScriptLines.Text := ScriptLines.Text;
  FFileName := AFileName;
  if Assigned(FOnLoadFromFile) then
    FOnLoadFromFile(Self);
  //ed.Modified := False;
end;

{ Save ScriptLines to the file specified during the last LoadFromFile.
  If no previous filename assigned, ask user using SaveAs method. }
procedure TULScript.Save;
begin
  if FFileName <> '' then begin
    SaveToFile(FFileName);
    //ed.Modified := False;
  end else begin
    SaveAs
  end;
end;

procedure TULScript.SaveToFile(const AFileName: string);
begin
  ScriptLines.SaveToFile(FFileName);
  FileScriptLines.Text := ScriptLines.Text;
  if FFileName <> AFileName then
    FFileName := AFileName;
  if Assigned(FOnSaveToFile) then
    FOnSaveToFile(Self);
  //ed.Modified := False;
end;

procedure TULScript.SaveAs;
begin
  if SaveDialog1.Execute then
    SaveToFile(SaveDialog1.FileName);
end;

procedure TULScript.Decompile(var ALines: TStrings);
var
  s: string;
begin
  if Compile then begin
    CompExec.GetCompiled(s);
    IFPS3DataToText(s, s);
    ALines.Text := s;
  end;
end;
{/public methods TULScript3.}

{CompExec Events}
procedure TULScript.CompExecAfterExecute(Sender: TIFPS3CompExec);
begin
  if Assigned(FAfterExecute) then
    FAfterExecute(Sender);
end;

procedure TULScript.CompExecCompile(Sender: TIFPS3CompExec);
begin
  if Assigned(FOnCompile) then
    FOnCompile(Sender);
  {adjusted from ide_demo: }
  {utl}
  Sender.AddMethod(Self, @TULScript.writeln, 'procedure writeln(s: string)');
  Sender.AddMethod(Self, @TULScript.readln, 'procedure readln(var s: string)');
  Sender.AddMethod(Self, @TULScript.ParamCount, 'function ParamCount: integer');
  Sender.AddMethod(Self, @TULScript.ParamStr, 'function ParamStr(i: integer): string');
  {/utl}

  {cul}
  Sender.AddMethod(Self, @TULScript.ObjSetStr, 'function ObjSetStr(AObjPath: string; APropName: string; AValue: string): boolean');
  Sender.AddMethod(Self, @TULScript.ObjGetStr, 'function ObjGetStr(AObjPath: string; APropName: string): string');
  Sender.AddMethod(Self, @TULScript.DevSetStr, 'function DevSetStr(ADeviceAlias: string; ADeviceProp: string; AValue: string): boolean');
  Sender.AddMethod(Self, @TULScript.DevGetStr, 'function DevGetStr(ADeviceAlias: string; ADeviceProp: string): string');
  Sender.AddMethod(Self, @TULScript.GetCurPath, 'function GetCurPath(AObjAliasPath: string): string');
  Sender.AddMethod(Self, @TULScript.GetDevicePath, 'function GetDevicePath(ADeviceAlias: string): string');
  Sender.AddMethod(Self, @TULScript.PrgToDev, 'procedure PrgToDev(ADeviceAlias: string; AParam: string)');
  Sender.AddMethod(Self, @TULScript.DevSetStrU , 'function DevSetStrU(ADeviceAlias: string; ADeviceProp: string; AValue: string): boolean');
  Sender.AddMethod(Self, @TULScript.DevGetStrU, 'function DevGetStrU(ADeviceAlias: string; ADeviceProp: string): string');
  {/cul}


  //Sender.AddRegisteredVariable('Self', 'TDataModule');
  Sender.AddRegisteredVariable('Application', 'TApplication');
  {/}
end;

procedure TULScript.CompExecExecute(Sender: TIFPS3CompExec);
begin
  if Assigned(FOnExecute) then
    FOnExecute(Sender);
  CompExec.SetVarToInstance('SELF', Self);
  CompExec.SetVarToInstance('APPLICATION', Application);
//  Caption := 'Editor - Running';
end;

procedure TULScript.CompExecIdle(Sender: TObject);
begin
  if Assigned(FOnIdle) then
    FOnIdle(Sender);
  Application.HandleMessage;
  if FResume then
  begin
    FResume := False;
    CompExec.Resume;
    FActiveLine := 0;
    //ed.Refresh;
  end;
end;


procedure TULScript.CompExecLineInfo(Sender: TObject; Position, Row,
  Col: Cardinal);
begin
  if CompExec.Exec.DebugMode = dmRun then begin
    FActiveLine := -1
  end else begin
    FActiveLine := Row;
    //ed.Refresh;
  end;
end;
{/CompExec Events}

procedure TULScript.DataModuleDestroy(Sender: TObject);
begin
  FMessages.Free;
  FScriptLines.Free;
  FFileScriptLines.Free;
end;

procedure TULScript.RunError(er: TIFError);
begin
  CompExec.Exec.CMD_Err(er);
end;

procedure TULScript.RunError2(er: TIFError; s: string);
begin
  CompExec.Exec.CMD_Err2(er, s);
end;

function TULScript.GetErrorMsg: string;
begin
  Result := CompExec.ExecErrorToString
end;

function TULScript.GetErrorCode: TIFError;
begin
  Result := CompExec.ExecErrorCode;
end;

function TULScript.GetErrorPos: integer;
begin
  Result := CompExec.ExecErrorPosition;
end;

procedure TULScript.RunCommandLine(const ACommandLine: string);
begin
  FCommandLine := ACommandLine;
  LoadFromCommandLine;
  if ErrorCode = ErNoError then begin
    Log('Script is running.');
    RunScript;
    if ErrorCode = ENoError then begin
      Log('Script finished, no errors.');
    end else begin
      Log(ErrorMsg);
    end;
  end;
end;

procedure TULScript.LoadFromCommandLine;
var
  n: string;
  i: integer;
begin
  //RunError(Self, ENoError);
  n := CommandLine;
  if (n <> '') then begin
    i := pos(' ', n);
    if i > 0 then
      n := copy(n, 1, i - 1);
    LoadFromFile(n);
  end else begin
    RunError2(erCustomError, 'EmptyCommand');
  end;
end;

procedure TULScript.Log(const msg: string);
begin
  if Assigned(FLogProc) then
    FLogProc(msg);
  ExeLog.Log('ULScript.'+ msg);
end;

function TULScript.GetScriptsDirList: string;
begin
  Result := ScriptsDir;
end;

procedure TULScript.Cleanup;
begin
  CompExec.Exec.Cleanup;
end;

{utl}
procedure StripQuotes(var AttrValue: string);{from attrib}
begin
  if (AttrValue <> '') and (AttrValue[length(AttrValue)] = '"') then
    SetLength(AttrValue, length(AttrValue) - 1);
  if (AttrValue <> '') and (AttrValue[1] = '"') then begin
    AttrValue := copy(AttrValue, 2, length(AttrValue));
  end;
end;

function TULScript.GetNextParam(var ACommandLine: string; var AParam: string): boolean;
var
  p: integer;
{  t: string;}
  isInQuotes:boolean;
begin
  Result := false;
  AParam := '';
  ACommandLine := trim(ACommandLine);
  if ACommandLine = '' then
    exit;
  isInQuotes := false;
  p := 1;
  while (p <= length(ACommandLine)) do begin
    if (ACommandLine[p] = ' ') and (not isInQuotes) then
      break;
    if ACommandLine[p] = '"' then
      isInQuotes := not isInQuotes;
    inc(p);
  end;
  AParam := copy(ACommandLine, 1, p - 1);
  ACommandLine := copy(ACommandLine, p + 1, length(CommandLine));
  StripQuotes(AParam);
  Result := AParam <> '';
end;
{/utl}

{utl export}
function TULScript.ParamCount: integer;
var
  s: string;
  p: string;
begin
  Result := 0;
  s := CommandLine;
  while GetNextParam(s, p) do inc(Result);
  if Result > 0 then
    Dec(Result);
end;

function TULScript.ParamStr(i:integer): string;
var
  j: integer;
  s: string;
  p: string;
begin
  Result := '';
  s := CommandLine;
  j := 0;
  while GetNextParam(s, p) do begin
    if j = i then begin
      Result := p;
      exit;
    end;
    inc(j);
  end;
end;
{utl export}

{cul utl}
function TULScript.ULObjFindPropInfo(const AObjPath: string; const APropName: string; var AObject: TObject; var APropInfo: PPropInfo): boolean;
var
  o: TULObj;
  f: TULObjField;
  ou: TObject;
begin
  Result := false;
  AObject := nil;
  APropInfo := nil;
  if not ULFKeeper.FindByULObjPath(AObjPath, 0, o) then begin
    Log('Obj with path ' + AObjPath + ' not found.');
    exit;
  end;
  if o <> nil then begin
    if not o.HasField(APropName, f) then begin
      if not o.HasUsrWithProp(APropName, ou, APropInfo) then
      begin
        Log('Property with name ' + APropName + ' not found in object ' + AObjPath + ' or its users.');
        exit;
      end;
      AObject := ou;
      Result := true;
    end else begin
      AObject := o;
      APropInfo := f.FldDesc.PropInfo;
      Result := true;
    end;
  end;
end;

function TULScript.FindProcessor(var AProcessor: TObject): boolean;
begin
  Result := false;
  if FUsr is TProcessor then begin
    AProcessor := TProcessor(FUsr);
    Result := true;
  end;
end;

function TULScript.FindChannel(var AChannel: TObject): boolean;
var o: TULObj;
begin
  Result := false;
  if FUsr is TChannel then begin
    AChannel := TChannel(FUsr);
    Result := true;
  end else if FUsr is TSeqPrg then begin
    o := TSeqPrg(FUsr).Obj;
    o := TULObj(o.Owner);
    {v0.51pi}
    if o=nil then
    begin
      Log('TULScript.FindChannel no SeqPrg owner');
      exit;
    end;
    {/v0.51pi}
    if o.RecID = ULIID then begin
      AChannel := Channels.FindChannel(TULIObj(o).ChannelName);
      Result := AChannel <> nil;
    end;
  end else if FUsr is TProcessor then begin
    AChannel := TProcessor(FUsr).Channel;
    Result := AChannel <> nil;
  end;
  if not Result then
    Log('No active channel found');
end;

function TULScript.FindSeqPrg(var ASeqPrg: TObject): boolean;
begin
  Result := false;
  if FUsr is TSeqPrg then begin
    ASeqPrg := TSeqPrg(FUsr);
    Result := true;
  end;
  if not Result then
    Log('No sequence program found');
end;

function TULScript.DevSetStrX(const ADeviceAlias: string;
  const ADeviceProp: string; const AValue: string; InUserUnits:boolean): boolean;
var
  o: TObject;
  pi: PPropInfo;
  p: string;
  c: TObject;
begin
  Result := false;
  if FindChannel(c) then with c as TChannel do begin
    if DeviceAliasToULObjPath(ADeviceAlias, p) then begin
      if ULObjFindPropInfo(p + '.' + ADeviceProp, pnValueInPC, o, pi) then begin
        if not InUserUnits then begin
          if ClassSetPropStr(o, pi, AValue) > 0 then begin
            Result := true;
          end else begin
            Log('DeviceSetStr failed to ClassSetPropStr ' + ADeviceAlias + ' '+
              ADeviceProp + ' ' + AValue);
          end;
        end else begin
          if o is TULObj then begin
            with o as TULObj do begin
              FindField(pnValueInPC).AsUsrString := AValue;{ulobju}
            end;
          end else begin
            Log('DevSetStrU - object is not ULObj');
          end;
        end;
      end else begin
        Log('ULObjPropInfo not found: ' + p + '.' + ADeviceProp + ',' + pnValueInPC);
      end;
    end else begin
      Log('DeviceAlias not found: ' + ADeviceAlias);
    end;
  end;
end;

function TULScript.DevGetStrX(const ADeviceAlias: string;
  const ADeviceProp: string; InUserUnits: boolean): string;
var
  o: TObject;
  pi: PPropInfo;
  p: string;
  c: TObject;
begin
  Result := '';
  if FindChannel(c) then with c as TChannel do begin
    if DeviceAliasToULObjPath(ADeviceAlias, p) then begin
      if ULObjFindPropInfo(p + '.' + ADeviceProp, pnValueInPC, o, pi) then begin
        if not InUserUnits then begin
          Result := ClassGetPropStr(o, pi);
        end else begin
          if o is TULObj then with o as TULObj do begin
            Result := FindField(pnValueInPC).AsUsrString;
          end else begin
            Log('DevGetStrU - object is not ULObj');
          end;
        end;
      end else begin
        Log('DevGetStr - ULObjPropInfo not found: ' + p + '.' + ADeviceProp + ',' + pnValueInPC);
      end;
    end else begin
      Log('DeviceAlias not found: ' + ADeviceAlias);
    end;
  end;
end;
{/cul utl}

{cul export}
function TULScript.ObjSetStr(const AObjPath: string; const APropName: string; const AValue: string): boolean;
var
  o: TObject;
  pi: PPropInfo;
begin
  if ULObjFindPropInfo(AObjPath, APropName, o, pi) then begin
    Result := ClassSetPropStr(o, pi, AValue) > 0;{proputl}
    if not Result then begin
      Log('Failed to SetPropStr to ' + AObjPath + ' ' + APropName + ' ' + AValue);
    end;
  end else begin
    Result := false;
  end;
end;

function TULScript.ObjGetStr(const AObjPath: string; const APropName: string): string;
var
  o: TObject;
  pi: PPropInfo;
begin
  Result := '';
  if ULObjFindPropInfo(AObjPath, APropName, o, pi) then
    Result := ClassGetPropStr(o, pi);
end;

function TULScript.DevSetStrU(const ADeviceAlias: string;
  const ADeviceProp: string; const AValue: string): boolean;
  { set value to device property in user units }
begin
  Result := DevSetStrX(ADeviceAlias, ADeviceProp, AValue, true);
end;

function TULScript.DevGetStrU(const ADeviceAlias:
  string; const ADeviceProp: string): string;
  { get value of device property in user units }
begin
  Result := DevGetStrX(ADeviceAlias, ADeviceProp, true);
end;

function TULScript.DevSetStr(const ADeviceAlias: string;
  const ADeviceProp: string; const AValue: string): boolean;
  { set value to device property in internal units }
begin
  Result := DevSetStrX(ADeviceAlias, ADeviceProp, AValue, false);
end;

function TULScript.DevGetStr(const ADeviceAlias: string;
  const ADeviceProp: string): string;
  { get value of device property in internal units }
begin
  Result := DevGetStrX(ADeviceAlias, ADeviceProp, false);
end;

function TULScript.GetDevicePath(const ADeviceAlias: string): string;
var
  p: string;
  c: TChannel;
begin
  Result := '';
  if FindChannel(TObject(c)) then with c as TChannel do begin
    if DeviceAliasToULObjPath(ADeviceAlias, p) then
      Result := p
    else begin
      Log('DeviceAlias not found: ' + ADeviceAlias);
    end;
  end;
end;

function TULScript.GetCurPath(const AULObjAliasPath: string): string;
var
  r: string;

  procedure GetActiveChannelPath;
  var
    c: TChannel;
  begin
    if FindChannel(TObject(c)) then
      r := c.ULN.ULObjPath;
  end;

  procedure GetActiveSequencePath;
  var
    p: TProcessor;
  begin
    if FindProcessor(TObject(p)) and (p.Sequence <> nil) then
      r := p.Sequence.ULSQ.ULObjPath;
  end;

  procedure GetActiveSampleHeadPath;
  var
    p: TProcessor;
  begin
    if FindProcessor(TObject(p)) and (p.CurSample <> nil) then
      r := p.CurSample.ULSR.ULObjPath;
  end;

  procedure GetActiveSampleDataPath;
  var
    p: TProcessor;
  begin
    if FindProcessor(TObject(p)) and (p.CurData <> nil) then
      r := p.CurData.ULA.ULObjPath;
  end;

  procedure GetNextSampleHeadPath;
  var
    p: TProcessor;
  begin
    if FindProcessor(TObject(p)) and (p.NextSample <> nil) then
      r := p.NextSample.ULSR.ULObjPath;
  end;

  procedure GetActiveProgramPath;
  var
    p: TProcessor;
  begin
    if FindProcessor(TObject(p)) and (p.CurPrg is TSeqPrg) then
      r := TSeqPrg(p.CurPrg).USP.ULObjPath;
  end;

begin
  r := '';
  if AULObjAliasPath = paActiveChannel then
    GetActiveChannelPath
  else if AULObjAliasPath = paActiveSequence then
    GetActiveSequencePath
  else if AULObjAliasPath = paActiveSampleHead then
    GetActiveSampleHeadPath
  else if AULObjAliasPath = paActiveSampleData then
    GetActiveSampleDataPath
  else if AULObjAliasPath = paNextSampleHead then
    GetNextSampleHeadPath
  else if AULObjAliasPath = paActiveProgram then
    GetActiveProgramPath
  else
    Log('Unknown AULObjAliasPath ' + AULObjAliasPath);
  Result := r;
end;

procedure TULScript.PrgToDev(const ADeviceAlias: string; const AParam: string);
var
  p: TProcessor;
  prg: TSeqPrg;
  chan: TChannel;
begin
  if FindProcessor(TObject(p)) then begin
    SeqPrgToDev(p.CurPrg, p.Channel, ADeviceAlias, AParam)
  end else if FindChannel(TObject(chan)) and FindSeqPrg(TObject(prg)) then
  begin
    SeqPrgToDev(prg, chan, ADeviceAlias, AParam);
  end;
end;
{CUL methods}


end.
