unit UnitJS;

interface

uses UnitPaste;

type
TJavaScript = class(TObject)
    protected
        fRequiresFocus : boolean;
        lastErr : string;
        fGeneratedScript : string;
        function createJSLitteralString(const str : string) : string;
        function MacroToJS(const macro : string) : string;
        function executeJSTask(hnd : THandle; paste : TPaste; javascript : string) : boolean;
        class function getFileHeader(pipeID : integer) : string;
    public
        class function getStartMacro : string;
        class function getEndMacro : string;
        class function getStartNoMacro : string;
        class function getEndNoMacro : string;
        class function isJavaScript(str : string) : boolean;
        class function GetMainLineOffset(scriptContent : string) : integer;
        class function GetScriptName : string;
        class function getMacroString : string;

        function requiresFocus : boolean;
        function getLastErr : string;
        function executeJS(hnd : THandle; paste : TPaste; javascript : string) : boolean;
        property GeneratedScript : string read fGeneratedScript;
end;





implementation

uses UnitToken, SysUtils, StrUtils, Windows, UnitMisc, UnitFrmDebug, IOUtils,
Classes, Forms, VCL.Clipbrd, Dialogs, UnitClipQueue;


// The user will only see this function
const
JS_NL = #13#10;
JS_START_MACRO = 'start_ac_macro:'#13#10;
JS_END_MACRO = 'end_ac_macro:'#13#10;

JS_POPUP_CLIPS = 'popupClips';
JS_SET_POPUP_CLIPS = '//@set '+JS_POPUP_CLIPS+'[]=';
JS_SET_ON = '"on"';
JS_SET_OFF = '"off"';
JS_MAIN_FUNCTION = 'function main(clipboardStr)';
JS_MAIN_HEADER =
    JS_MAIN_FUNCTION + ' {' + JS_NL +
    JS_SET_POPUP_CLIPS + JS_SET_OFF + JS_NL +
    '//change to "on" to include the Popup Clips list as a string array' + JS_NL +
    '//' + JS_NL +
    '// use manuallyExecuteMacro(string) for dynamically built macros' + JS_NL +
    '// use saveToPopupClips(string) to save text to the Popup Clips list' + JS_NL;
JS_MAIN_FOOTER =
    '}';
JS_MAIN_HEADER_W_MACRO =
    JS_MAIN_HEADER +
    JS_START_MACRO;
JS_MAIN_FOOTER_W_MACRO =
    JS_END_MACRO + JS_MAIN_FOOTER;
JS_SCRIPTNAME = 'main.js';
JS_SIGNALNAME = 'signal.txt';

class function TJavaScript.isJavaScript(str : string) : boolean;
var i : integer;
begin
    i := ansiPos(JS_MAIN_FUNCTION, str);
    result := (i > 0);
end;

class function TJavaScript.getStartMacro : string;
begin
    result := JS_MAIN_HEADER_W_MACRO;
end;
class function TJavaScript.getEndMacro : string;
begin
    result := JS_MAIN_FOOTER_W_MACRO;
end;
class function TJavaScript.getMacroString : string;
begin
    result := getStartMacro + getEndMacro;
end;
class function TJavaScript.getStartNoMacro : string;
begin
    result := JS_MAIN_HEADER;
end;
class function TJavaScript.getEndNoMacro : string;
begin
    result := JS_MAIN_FOOTER;
end;





// the script will write AC Macros to the named pipe for communication
const PIPE_NAME = 'ACJavaScript';
const NL = JS_NL;

// insert statically instantiated objects here
//    function main() {
JF_MAIN_FOOTER =
//    '} // end main()
    'main(clipboardStr);' +  NL +
    'pipe.Write("END");' + NL +
    'pipe.Close();' +
    'WScript.Quit(1)';


class function TJavaScript.getFileHeader(pipeID : integer)  : string;
var s : string;
begin
    s := TPath.Combine(GetAppPath, 'JavaScript');
    s := ReplaceStr(s, '\','\\');
    result :=  'var fs = new ActiveXObject("Scripting.FileSystemObject");' + NL +

    'var opened = false;' + NL +
     'var pipe = fs.OpenTextFile("\\\\.\\pipe\\'+PIPE_NAME+IntToStr(pipeId)+'", 8, false, 0);' + NL +
    //'var pipe = fs.CreateTextFile("\\\\.\\pipe\\'+PIPE_NAME+IntToStr(pipeId)+'", false);' + NL +
//    'var signal = fs.CreateTextFile("'+s+'\\'+JS_SIGNALNAME+'", true);' + NL +
//    'signal.Close();' +NL+
    'function manuallyExecuteMacro(macro) {pipe.Write(macro);}' + NL +
    'function saveToPopupClips(clip) {pipe.Write(''[newclip=\"''+clip.replace(''"'',''""'')+''\"]'');}' +NL;
end;



function TJavaScript.getLastErr : string;
begin
    result := lastErr;
end;
function TJavaScript.createJSLitteralString(const str : string) : string;
begin
    result := str;
    if length(result) = 0 then begin
        result := '""';
        EXIT;
    end;

    if result[length(result)] = #0 then begin
        delete(result,length(result),1);
    end;
    result := ReplaceText(result, '\', '\\');
    result := ReplaceText(result, '''', '\''');
    result := ReplaceText(result, '"', '\"');
    result := ReplaceText(result, #13, '\r');
    result := ReplaceText(result, #10, '\n');
    result := '"' + result + '"';
end;
function TJavaScript.MacroToJS(const macro : string) : string;
var
    s : string;
begin
    s := macro;
    if macro[length(macro)] = #10 then begin
        delete(s,length(s)-1, 2);
    end;
    s := createJSLitteralString(s);
    result := 'pipe.Write('+ s +');' + NL;
end;
function TJavaScript.executeJS(hnd : THandle;paste : TPaste; javascript : string) : boolean;
begin
    //
    // This was a workaround that may not be needed anymore with the first call
    // to ConnectNamedPipe failing
    //
    result := executeJSTask(hnd, paste, javascript);
    if not result and (lastErr='') then begin
        result :=  executeJSTask(hnd, paste, javascript);
    end;
end;
function TJavaScript.executeJSTask(hnd : THandle;paste : TPaste; javascript : string) : boolean;
    procedure SaveMainScript(var path : string; pipeID : integer);
        function encodeACMacros(javascript : string) : string;
        var
            s : string;
            macro : string;
        begin
            while (javascript <> '') do begin
                result := result + TokenString(javascript,JS_START_MACRO,false);
                if (javascript <> '') then begin
                    macro := TokenString(javascript,JS_END_MACRO,false);
                    result := result + macroToJS(macro);
                end;
            end;
        end;
        function wrapEncodedMacros(encodedMacros : string;pipeID : integer) : string;
        var
            i : integer;
            cnt : integer;
            clipb : string;
        begin
            result := '';
            clipb := Clipboard.AsText;

            cnt := ClipQueue.GetQueueCount;
            if PosI(JS_SET_POPUP_CLIPS+JS_SET_ON, encodedMacros) <> 0 then begin
                result := 'var '+JS_POPUP_CLIPS+'= [' ;
                for i:= 0 to cnt - 1  do begin
                    result := result + self.createJSLitteralString(ClipQueue.GetClipItem(i).GetAsPlaintext);
                    if (i<>(cnt - 1)) then begin
                        result := result + ',';
                    end;
                end;
                result := result + '];' + JS_NL;
            end;
            result := result +

            getFileHeader(pipeID) +
            'var clipboardStr = '+ createJSLitteralString(clipb) + ';'+ JS_NL +
            encodedMacros + JS_NL +
            JF_MAIN_FOOTER;
        end;

    var
        sl : TStringList;
    begin

        fGeneratedScript := encodeACMacros(javascript);
        fGeneratedScript := wrapEncodedMacros(fGeneratedScript, pipeID);

        path := TPath.Combine(GetAppPath, 'JavaScript');
        if not DirectoryExists(path) then begin
            ForceDirectories(path);
        end;

        path := TPath.Combine(path, JS_SCRIPTNAME);
        sl := TStringList.Create;
        sl.Add(fGeneratedScript);
        sl.SaveToFile(path);
        myfree(sl);
    end;
    function GetPipeHandle(var h : THandle; pipeID : integer) : boolean;

        function createPipe(name : string) : THandle;
        var
            s : string;
        const
            MAX_BUFFERS = 100;
            KILOBYTES = 1024;
            MAX_SECONDS = 10;
            MILLISECONDS = 1000;
            MAX_INSTANCES = 1;

        begin
            s := '\\.\pipe\' + name;
            result := CreateNamedPipe(
                PChar(S),
                PIPE_ACCESS_DUPLEX Or FILE_FLAG_WRITE_THROUGH or FILE_FLAG_OVERLAPPED,
                PIPE_WAIT Or PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE, // read/write mode
                MAX_INSTANCES,
                MAX_BUFFERS * KILOBYTES, MAX_BUFFERS * KILOBYTES, // out and in buffers
                MAX_SECONDS * MILLISECONDS,  // client timeout
                nil
            );
        end;
    var errCount : integer;
    begin
        errCount := 0;
        repeat
            h := createPipe(PIPE_NAME+IntToStr(pipeId));
            if (h = INVALID_HANDLE_VALUE) then begin
                inc(errCount);
                MySleep(10);
            end;
        until (h<> INVALID_HANDLE_VALUE) or  (errCount >= 5);
        result := h <> INVALID_HANDLE_VALUE;
    end;
    procedure InitErrorLog(var errLog : string);
    begin
        errLog := TPath.Combine(GetAppPath,'JavaScript\err.txt');
        DeleteFile(PChar(errLog));
    end;
    function IsRunning(cmdResult : integer) : boolean;
    var
        r : cardinal;
    begin
        result := false;
        if GetExitCodeProcess(cmdResult, r) then begin
            result := r = STILL_ACTIVE;
        end;
    end;

    function PerformPipeConnect(h : THandle) : THandle;
    var

        ol : OVERLAPPED;
        pipeEvent : THandle;
        err : cardinal;
    begin
        // Not connecting and attempting a read from the pipe
        // causes ConnectNamedPipe to fail on subsequent attempts.
        // It seems to not close the pipe even though CloseHandle is called
        result := 0;

        ZeroMemory(@ol, SizeOf(ol));
        pipeEvent := CreateEvent(nil, true, False, nil); // must be manually reset event for overlapped IO
        ol.hEvent := pipeEvent;
        if not ConnectNamedPipe(h, @ol) then begin
            err := GetLastError();
            if err = ERROR_PIPE_CONNECTED then begin
                FrmDebug.AppendLog('Client already connected');
                SetEvent(ol.hEvent); // signal the event
                result := ol.hEvent;
            end else if err = ERROR_IO_PENDING then begin
                result := ol.hEvent;
                FrmDebug.AppendLog('No client already connected');
            end;
        end;
    end;
    procedure ClearSignal;
    begin
       SysUtils.DeleteFile(TPath.Combine(GetAppPath, 'JavaScript\'+JS_SIGNALNAME));
    end;
    function WaitForSignal(cmdResult : integer) : boolean;
    var i : integer;
        signalName : string;
        found, running  : boolean;
    begin
        result := IsRunning(cmdResult);
        EXIT;

        found := false;
        i := 0;
        signalName :=  TPath.Combine(GetAppPath, 'JavaScript\'+JS_SIGNALNAME);
        running := isRunning(cmdResult);
        repeat
            inc(i);

            found := FileExists(signalName);
            if (not found) then
                mysleep(10);
            if (i mod 10) = 0 then begin
                running := isRunning(cmdResult);
            end;
        until (i>50) or found or (not running);
        result := found;
    end;
    function PerformPipeReads(h : THandle; eventHandle : THandle; cmdResult : integer) : boolean;
    var
        connectOK : boolean;
        byteCount : DWORD;
        bytesRead : Cardinal;
        buffer : array[0..1000*100] of byte;
        inMacro : string;
        endFound : boolean;
        waitResult : boolean;
        function DoWaitForClient(eventHandle : THandle; cmdResult : integer) : boolean;
        var i : integer;
        const
            TOTAL_MAX_WAIT_MS = 1000;
            SIGNAL_WAIT_MS = 100;
        begin
            // Client may terminate with an error, never connecting to pipe.
            // Detect this case and early abort.
            result := false;
            i := 0;
            repeat
                result := WaitForSingleObject(eventHandle, SIGNAL_WAIT_MS) = WAIT_OBJECT_0;
                if not result then begin
                    if not IsRunning(cmdResult) then EXIT;
                end;
                inc(i, SIGNAL_WAIT_MS);
            until result or (i >= TOTAL_MAX_WAIT_MS);
        end;
    begin
        result := false;
        connectOK := false;
        waitResult := DoWaitForClient(eventHandle, cmdResult);
        if waitResult then begin
            connectOK := true;
            repeat
                inMacro := '';
                if ReadFile(h,buffer,sizeof(buffer),bytesRead,nil) then begin
                    buffer[bytesRead] := 0;
                    inMacro := inMacro + string(pansichar(@buffer));
                end else begin
                    FrmDebug.AppendLog('JavaScript - cant read file',false);
                    connectOK := false;
                    BREAK;
                end;

                endFound := (inMacro = 'END');
                if not endFound then begin
                    Paste.SendMacro(KEYS_STR+inMacro);
                end;
            until endFound;
        end;

        result := connectOK;

    end;
    procedure PerformErrorReporting(cmdResult : integer; errLog : string);
    var
        sl : TStringList;
        s : string;
    begin
        // Wait more time only if the script is still running
        if  WaitForSingleObject(cmdResult, 10) <> WAIT_OBJECT_0 then begin
            case WaitForSingleObject(cmdResult, 2000) of
            WAIT_FAILED :
                begin
                    lastErr := SysErrorMessage( GetLastError );
                end;
            WAIT_TIMEOUT:
                begin
                    lastErr := 'Error: Script timed out';
                end;
            end;
        end;
        if not CloseHandle(cmdResult) then begin
            FrmDebug.AppendLog('JavaScript: couldn''t close process handle', true);
        end;
        sl := TStringList.Create;
        sl.LoadFromFile(errLog);
        s := sl.Text;
        if (s<>'') then begin
            frmdebug.AppendLog(s, false);
        end;
        lastErr := s;
        myfree(sl);
    end;
var
    h : THandle;
    command, errLog : string;
    cmdResult : integer;
    path : string;
    pipeID : integer;
    eventHandle : THandle;
    r : cardinal;
    tm : cardinal;
begin
    tm := Windows.GetTickCount;
    frmDebug.AppendLog('JavaScript started');
    result := false;
    lastErr := '';
    fGeneratedScript := '';
    pipeID := Random(10000);

    SaveMainScript(path, pipeID);
    if not GetPipeHandle(h, pipeID) then begin
        FrmDebug.AppendLog('unitJS: namepipe failed ', true);
        EXIT;
    end;

    InitErrorLog(errLog);
    eventHandle := PerformPipeConnect(h);
    if (eventHandle <> 0) then begin
        ClearSignal;
        command := 'cmd.exe /s /c "cscript /nologo "'+path+'" 2> "'+errLog+'""';
        cmdResult := UnitMisc.RunCommandLine(command);
        if RunCommandResultSuccess(cmdResult) then begin
            if WaitForSignal(cmdResult) then begin
                result := PerformPipeReads(h, eventHandle, cmdResult);
            end;
        end else begin
            lastErr := SysErrorMessage( RunCommandResultToSysErrorCode(cmdResult) );
        end;
        DisconnectNamedPipe(h);
    end else begin
        lastErr := 'Error: unable to connect to pipe';
    end;
    CloseHandle(h);
    if not result then begin
        PerformErrorReporting(cmdResult, errLog);
    end;
    FrmDebug.AppendLog('JavaScript ended timems='+IntToStr(Windows.GetTickCount-tm),false);
end;

class function TJavaScript.GetMainLineOffset(scriptContent : string) : integer;
var
    s : string;
    i : integer;
begin
    result := -1;
    i := 0;
    repeat
        s := UnitToken.TokenString(scriptContent, JS_NL, false);
        if pos(JS_MAIN_FUNCTION, s) > 0 then begin
            result := i;
            BREAK;
        end;
        inc(i);
    until scriptContent = '';
end;
class function TJavaScript.GetScriptName : string;
begin
    result := JS_SCRIPTNAME;
end;

function TJavaScript.requiresFocus : boolean;
begin
    result := fRequiresFocus;
end;

initialization
begin
end;
end.
