Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyScripting.p

Text File | 1996-05-29 | 8.7 KB | 327 lines | [TEXT/CWIE]

unit MyScripting;

interface

    uses
        OSA;

    function InitScripting: OSAError;
    function FinishScripting: OSAError;
    procedure InitContext;
    procedure SaveContext;
    procedure FinishContext;
    function CompileScript (h: Handle; var id: OSAID): OSAError;
    function DestroyScript (id: OSAID): OSAError;
    function ExecuteScript (id: OSAID): OSAError;
    procedure MyGetScriptErrorInfo (var error: OSAError; var start, fin: integer; var errmsg: Str255);
    function ExecScript (script: Handle; var error: OSAError; var start, fin: integer; var errmsg: Str255): OSErr;
    function EvaluateScript (script: Handle; resultType: DescType; var result: AEDesc): OSAError;

implementation

    uses
        AppleScript, MyStrings, MyUtils,{}
        MyStrH, QLowLevel,{}
        MyVersionResource, MyNewPreferences, MyMachineNames, MyAEUtils;

    type
        XXXAEDescPtr = ^AEDesc;

    const
        kComponentNotFound = -2;

    var
        gScriptingComponent: ComponentInstance;
        gScriptingName: Str255;
        gContext: OSAID;

    function Deque (var p: univ QElemPtr; var head: QHdr): boolean;
    begin
        p := nil;
        while (p = nil) & (head.qHead <> nil) do begin
            p := head.QHead;
            if Dequeue(p, @head) <> noErr then begin
                p := nil;
            end;
        end;
        Deque := p <> nil;
    end;

    procedure InitContext;
        var
            oe, ooe: OSAError;
            h: Handle;
            desc: AEDesc;
    begin
        if gContext <> kOSANullScript then begin
            oe := OSADispose(gScriptingComponent, gContext);
            gContext := kOSANullScript;
        end;
        ReadPrefsHandle(h, kOSAScriptResourceType, 128);
        if h <> nil then begin
            HLock(h);
            oe := AECreateDesc(typeOSAGenericStorage, h^, GetHandleSize(h), desc);
            HUnlock(h);
            DisposeHandle(h);
            h := nil;
            if oe = noErr then begin
                gContext := kOSANullScript;
                oe := OSALoad(gScriptingComponent, desc, kOSANullMode, gContext);
                if oe <> noErr then begin
                    gContext := kOSANullScript;
                end;
                AEDestroy(desc);
            end;
        end;
        if gContext = kOSANullScript then begin
            oe := OSAMakeContext(gScriptingComponent,XXXAEDescPtr(nil)^, kOSANullScript, gContext);
            if oe <> noErr then begin
                gContext := kOSANullScript;
            end;
        end;
    end;

    procedure SaveContext;
        var
            desc: AEDesc;
            oe, ooe: OSAError;
    begin
        if gContext <> kOSANullScript then begin
            oe := OSAStore(gScriptingComponent, gContext, typeOSAGenericStorage, 0, desc);
            if oe = noErr then begin
                WritePrefsHandle(desc.dataHandle, kOSAScriptResourceType, 128);
                AEDestroy(desc);
            end;
        end;
    end;

    procedure FinishContext;
        var
            oe: OSAError;
    begin
        if gContext <> kOSANullScript then begin
            oe := OSADispose(gScriptingComponent, gContext);
        end;
    end;

    function InitScripting: OSAError;
        var
            oe: OSAError;
            desc: ComponentDescription;
            mine: Component;
            er: EventRecord;
            named: AEDesc;
    begin
        gContext := kOSANullScript;

        desc.componentType := kOSAComponentType;
        desc.componentSubType := kAppleScriptSubtype;
        desc.componentManufacturer := OSType(0);
        desc.componentFlags := kOSASupportsCompiling + kOSASupportsGetSource + kOSASupportsAESending;
        desc.componentFlagsMask := desc.componentFlags;

        oe := kComponentNotFound;
        mine := FindNextComponent(nil, desc);
        if mine <> nil then begin
            gScriptingComponent := OpenComponent(mine);
            if gScriptingComponent <> nil then begin
                gScriptingName := '?';
                oe := OSAScriptingComponentName(gScriptingComponent, named);
                if oe = noErr then begin
                    oe := GetStringFromAEDesc(named, gScriptingName);
                    AEDestroy(named);
                end;
                if oe = noErr then begin
                    oe := OSAMakeContext(gScriptingComponent, XXXAEDescPtr(nil)^, kOSANullScript, gContext);
                end;
                if oe <> noErr then begin
                    gContext := kOSANullScript;
                end;
                oe := noErr;
            end;
        end;

        InitScripting := oe;
    end;

    function FinishScripting: OSAError;
    begin
        FinishScripting := CloseComponent(gScriptingComponent);
    end;

    function CompileScript (h: Handle; var id: OSAID): OSAError;
        var
            desc: AEDesc;
            oe, ooe: OSAError;
    begin
        HLock(h);
        oe := AECreateDesc(typeChar, h^, GetHandleSize(h), desc);
        HUnlock(h);
        if oe = noErr then begin
            id := kOSANullScript;
            oe := OSACompile(gScriptingComponent, desc, kOSANullMode, id);
            AEDestroy(desc);
        end;
        CompileScript := oe;
    end;

    function DestroyScript (id: OSAID): OSAError;
    begin
        DestroyScript := OSADispose(gScriptingComponent, id);
    end;

    function ExecuteScript (id: OSAID): OSAError;
        var
            resultID: OSAID;
            oe, ooe: OSAError;
    begin
        oe := OSAExecute(gScriptingComponent, id, gContext, kOSANullMode, resultID);
        if oe = noErr then begin
            ooe := OSADispose(gScriptingComponent, resultID);
        end;
        ExecuteScript := oe;
    end;

    procedure MyGetScriptErrorInfo (var error: OSAError; var start, fin: integer; var errmsg: Str255);
        type
            OSErrPtr = ^OSErr;
            OSErrHandle = ^OSErrPtr;
        var
            errorMessage: Handle;
            desc, recordDesc: AEDesc;
            actualType: DescType;
            actualSize: Size;
            oe: OSAError;
            s: Str255;
    begin
        oe := OSAScriptError(gScriptingComponent, kOSAErrorNumber, typeShortInteger, desc);
        error := OSErrHandle(desc.dataHandle)^^;
        AEDestroy(desc);

        oe := OSAScriptError(gScriptingComponent, kOSAErrorRange, typeOSAErrorRange, desc);
        oe := AECoerceDesc(desc, typeAERecord, recordDesc);
        oe := AEGetKeyPtr(recordDesc, keyOSASourceStart, typeShortInteger, actualType, Ptr(@start), sizeOf(start), actualSize);
        oe := AEGetKeyPtr(recordDesc, keyOSASourceEnd, typeShortInteger, actualType, Ptr(@fin), sizeOf(fin), actualSize);
        AEDestroy(desc);
        AEDestroy(recordDesc);

        oe := OSAScriptError(gScriptingComponent, kOSAErrorMessage, typeChar, desc);
        HandleToString(desc.dataHandle, errmsg);
        AEDestroy(desc);
    end;

    function ExecScript (script: Handle; var error: OSAError; var start, fin: integer; var errmsg: Str255): OSErr;
        var
            err, oe, ooe: OSAError;
            scriptID, resultID: OSAID;
            resultText: AEDesc;
    begin
        error := 0;
        start := 0;
        fin := 0;
        errmsg := '';
        err := CompileScript(script, scriptID);
        SetHandleSize(script, 0);
        if err <> noErr then begin
            if err = errOSAScriptError then begin
                MyGetScriptErrorInfo(error, start, fin, errmsg);
            end;
        end
        else begin
            err := OSAExecute(gScriptingComponent, scriptID, gContext, kOSANullMode, resultID);
            ooe := OSADispose(gScriptingComponent, scriptID);
            SaveContext;
            if err = noErr then begin
                err := OSADisplay(gScriptingComponent, resultID, typeChar, kOSANullMode, resultText);
                ooe := OSADispose(gScriptingComponent, resultID);
                if err = noErr then begin
                    err := HandAndHand(resultText.dataHandle, script);
                    AEDestroy(resultText);
                end;
            end
            else if err = errOSAScriptError then begin
                MyGetScriptErrorInfo(error, start, fin, errmsg);
            end;
            if err <> noErr then begin
                SetHandleSize(script, 0);
            end;
        end;
        ExecScript := err;
    end;

    function EvaluateScript (script: Handle; resultType: DescType; var result: AEDesc): OSAError;
        var
            scriptID, resultID: OSAID;
            err, junk: OSAError;
    begin
        AECreate(result);
        err := CompileScript(script, scriptID);
        if err = noErr then begin
            err := OSAExecute(gScriptingComponent, scriptID, kOSANullScript, kOSANullMode, resultID);
            junk := OSADispose(gScriptingComponent, scriptID);
            if err = noErr then begin
                err := OSACoerceToDesc(gScriptingComponent, resultID, resultType, kOSANullMode, result);
                junk := OSADispose(gScriptingComponent, resultID);
            end;
        end;
        EvaluateScript := err;
    end;

end.
function ValidatePassword (username, password: Str255): boolean;
    procedure QuoteStuff (var s: Str255);
        var
            i: integer;
    begin
        i := 1;
        while (i < length(s)) do begin
            if s[i] = '"' then begin
                Insert('\', s, i);
                i := i + 1;
            end;
            i := i + 1;
        end;
    end;
    var
        script: Handle;
        s: Str255;
        scriptID, resultID: OSAID;
        resultDesc: AEDesc;
        oe, ooe: OSAError;
begin
    ValidatePassword := false;
    if IUEqualString(username, GetOwnerName) = 0 then begin
        QuoteStuff(username);
        QuoteStuff(password);
        SPrintS3(s, GetIndStr(128, 5), username, password, '');
        script := NewHandle(0);
        StringToHandle(s, script);
        oe := CompileScript(script, scriptID);
        DisposeHandle(script);
        if oe = noErr then begin
            oe := OSAExecute(gScriptingComponent, scriptID, kOSANullScript, kOSANullMode, resultID);
            ooe := OSADispose(gScriptingComponent, scriptID);
            if oe = noErr then begin
                oe := OSACoerceToDesc(gScriptingComponent, resultID, typeBoolean, kOSANullMode, resultDesc);
                ValidatePassword := resultDesc.dataHandle^^ <> 0;
                ooe := OSADispose(gScriptingComponent, resultID);
                if oe = noErr then begin
                    AEDestroy(resultDesc);
                end;
            end;
        end;
    end;
end;

procedure ExecScriptOld (script, result: Handle);
    var
        oe: OSAError;
        scriptID, resultID: OSAID;
begin
    oe := CompileScript(script, scriptID);
    writeln(oe);
    oe := ExecuteScript(scriptID);
    writeln(oe);
    oe := DestroyScript(scriptID);
    writeln(oe);
end;