{--------------------------------------------------------}
{
{    Mini interpretador de script
{
{    Autor: José Antonio Borges
{
{    Em 23/06/2000
{
{--------------------------------------------------------}

{--------------------------------------------------------}
{
{    Resumo da sintaxe
{
{    Interações com o usuário
{        escreve ["frase" ou variavel]...  {terminado por & nao pula linha
{        toca "frase" ou variavel          {terminado por & nao espera terminar
{        le [variavel ou &tecla]
{        tela [limpa ou minimizada ou normal ou @x,y]
{    Operações com arquivo
{        arquiva arquivo [variavel]        {terminado por & nao pula linha
{        remove arquivo
{        executa ["frase" ou variavel]
{    Operações com janelas
{        espera [tempo] ["nome janela" ou variavel]
{        janela ["nome janela" ou variavel] [fecha, minimiza, maximiza, normal]
{    Ações do teclado
{        digita "frase" [enter]
{        aciona [tecla virtual]
{    Ações do mouse:
{        clica [duplo] [onde]
{    Processamento de variáveis
{        seja variavel "frase"
{        soma [variavel] [valor ou variavel]
{        concatena [variavel] [valor ou variavel]
{        obtem [variavel] TITULO, CAMPO, FOCO, subjanela [variavel ou número, ...]
{    Processamento de desvios
{        se [variavel, TITULO, CAMPO, FOCO] =,<,>,<>,inicio ["valor" ou variavel] comando
{        desvia [rotulo]
{        chama [rotulo]
{        retorna
{        debug ligado/desligado
{        cmd [variavel]
{        termina [mudo]
{    [Onde]
{        x, y
{        tela x, y
[        subjanela [variavel ou número]
{    [variavel]  letra de a-z (maiusculas identicas a minusculas)
{    [rotulo]  qualquer coisa começada por '@'
{    [arquivo]  frase ou variavel
{    comentario: linha começada por *
{
{--------------------------------------------------------}

unit dvscript;

interface
uses dvwin, dvcrt, winprocs, wintypes, strings, dvmacro, dvexec, mmsystem;

const
    SCR_OK = 0;
    SCR_ERROEXEC = 1;
    SCR_SEMARQUIVO = 2;
    SCR_ROTULOINVALIDO = 3;

type
    str255 = string[255];
    pstrScript = ^str255;
var
    varScript: array ['A'..'Z'] of pstrScript;

function cmdScript (lido: string): boolean;
function executaScript (nomeArq, rotulo: string; var ultLinhaProc: integer): integer;

implementation

const
    MAXSCRIPT = 1000;
    MAXRETORNO = 20;

const
    DEBUG_DESLIGADO  = 'Debug desligado';
    DEBUG_LIGADO     = 'Debug ligado';
    ERRO_ARQUIVO     = 'Erro de escrita no arquivo';
    STACK_OVERFLOW   = 'Muitas chamadas sem retorno';
    STACK_UNDERFLOW  = 'Retorno sem chamada';
    COMANDO_INVALIDO = 'Comando inválido: ';

type
    pVetScript = ^vetScript;
    vetScript = array [1..MAXSCRIPT] of pstrScript;

var
    script: pVetScript;
    nlinhasScript: integer;
    linhaAtual: integer;
    topoRetorno: integer;
    pilhaRetorno: array [1..MAXRETORNO] of integer;
    debug: boolean;
    fimProc, erroProc, mudo: boolean;
    cmd: string;
    arq: text;

{--------------------------------------------------------}
{             carrega um script na memoria
{--------------------------------------------------------}

function carregaScript (nomeArq: string): boolean;
var
    lido: string;
begin
    assign (arq, nomeArq);
    {$I-} reset (arq);  {$I+}
    if ioresult <> 0 then
        begin
            carregaScript := false;
            exit;
        end;

    new (script);
    nlinhasScript := 0;
    while (not eof (arq)) do
        begin
            readln (arq, lido);
            nlinhasScript := nlinhasScript + 1;

            while (lido <> '') and (lido[1] = ' ') do
                delete (lido, 1, 1);

            getMem (script^[nlinhasScript], length (lido) + 1);
            script^[nlinhasScript]^ := lido;
        end;

    close (arq);
    carregaScript := true;
end;

{--------------------------------------------------------}
{                 libera a area de script
{--------------------------------------------------------}

procedure liberaScript;
var i: integer;
begin
    for i := 1 to nlinhasScript do
        freeMem (script^[i], length (script^[i]^) + 1);
    dispose (script);
    nlinhasScript := 0;
end;

{--------------------------------------------------------}
{      remove brancos ao inicio e fim de uma cadeia
{--------------------------------------------------------}

procedure trim (var lido: string);
begin
    while (lido <> '') and (lido[1] = ' ') do
        delete (lido, 1, 1);
    while (lido <> '') and (lido[length(lido)] = ' ') do
        delete (lido, length(lido), 1);
end;

{--------------------------------------------------------}
{             transforma cadeia em maiusculos
{--------------------------------------------------------}

function maiusc (s: string): string;
begin
    s := s + #$0;
    ansiUpper (@s[1]);
    delete (s, length (s), 1);
    maiusc := s;
end;

{--------------------------------------------------------}
{             busca um rótulo no arquivo
{--------------------------------------------------------}

function buscaRotulo (rotulo: string): boolean;
var i: integer;
    lido: string;
begin
    rotulo := maiusc (rotulo);
    for i := 1 to nlinhasScript do
        begin
            lido := script^[i]^;
            if lido[1] = '@' then
                 begin
                     if maiusc (copy (lido, 2, length (lido)-1)) = rotulo then
                         begin
                             buscaRotulo := true;
                             linhaAtual := i;
                             exit;
                         end;
                 end;
        end;
     buscaRotulo := false;
end;

{--------------------------------------------------------}
{    transforma o lido num parametro string ou variavel
{--------------------------------------------------------}

function extraiValor (var lido: string; var valor: string): boolean;
var tam: integer;
begin
    extraiValor := false;
    valor := '';

    if lido[1] in ['0'..'9', '-'] then
        begin
            repeat
                valor := valor + lido[1];
                delete (lido, 1, 1);
            until (lido = '') or (not (lido[1] in ['0'..'9']));
        end
    else
    if lido[1] = '"' then
        begin
            delete (lido, 1, 1);
            tam := pos ('"', lido);
            if tam = 0 then tam := length (lido)+1;
            valor := copy (lido, 1, tam-1);
            delete (lido, 1, tam);
        end
    else
    if upcase(lido[1]) in ['A'..'Z'] then
        begin
            valor := varScript [upcase(lido[1])]^;
            delete (lido, 1, 1);
        end
    else
        exit;   { erro }

    if (lido <> '') and (lido[1] <> ' ') then exit;
    extraiValor := true;
end;

{--------------------------------------------------------}
{                    Comando Debug
{--------------------------------------------------------}

function processaDebug (lido: string): boolean;
begin
    if (lido = '-') or
       (copy (lido, 1, 1) = 'N') then
        begin
            debug := false;
            sintWriteln (DEBUG_DESLIGADO);
        end
    else
        begin
            debug := true;
            sintWriteln (DEBUG_LIGADO);
        end;
end;

{--------------------------------------------------------}
{                   comando seja
{--------------------------------------------------------}

function processaSeja (lido: string): boolean;
var v: char;
begin
    processaSeja := false;
    if (lido = '') or (not (upcase(lido[1]) in ['A'..'Z'])) then
        exit;

    v := upcase(lido[1]);
    delete (lido, 1, 1);
    if copy (lido, 1, 1) <> ' ' then exit;
    trim (lido);
    if lido = '' then exit;

    if lido[1] = '"' then
        begin
            delete (lido, 1, 1);
            if lido[length(lido)] = '"' then delete (lido, length(lido), 1);
        end;

    varScript[v]^ := lido;
    processaSeja := true;
end;

{--------------------------------------------------------}
{                   comando soma
{--------------------------------------------------------}

function processaSoma (lido: string): boolean;
var v: char;
    s, norig: string;
    n, o: longint;
    erro: integer;
begin
    processaSoma := false;
    if (lido = '') or (not (upcase(lido[1]) in ['A'..'Z'])) then
        exit;

    v := upcase(lido[1]);
    delete (lido, 1, 1);
    if copy (lido, 1, 1) <> ' ' then exit;
    trim (lido);
    if lido = '' then exit;

    val (lido, n, erro);
    if erro <> 0 then exit;

    norig := '';
    s := varScript[v]^;
    while (s <> '') and (s[length (s)] in ['0'..'9']) do
        begin
            norig := s[length(s)] + norig;
            delete (s, length(s), 1);
        end;
    if (s <> '') and (s[length (s)] = '-') then
         begin
            norig := s[length(s)] + norig;
            delete (s, length(s), 1);
         end;
    val (norig, o, erro);

    str (o+n, norig);
    varScript[v]^ := s + norig;

    processaSoma := true;
end;

{--------------------------------------------------------}
{                   comando concatena
{--------------------------------------------------------}

function processaConcatena (lido: string): boolean;
var v: char;
begin
    processaConcatena := false;

    if (lido = '') or (not (upcase(lido[1]) in ['A'..'Z'])) then
        exit;

    v := upcase(lido[1]);
    delete (lido, 1, 1);
    if copy (lido, 1, 1) <> ' ' then exit;
    trim (lido);
    if lido = '' then exit;

    if lido[1] = '"' then
        begin
            delete (lido, 1, 1);
            if lido[length(lido)] = '"' then delete (lido, length(lido), 1);
        end
    else
    if upcase(lido[1]) in ['A'..'Z'] then
        begin
            if length (lido) <> 1 then exit;   { erro }
            lido := varScript[upcase(lido[1])]^;
        end
    else
        exit;   { erro }

    varScript[v]^ := varScript[v]^ + lido;

    processaConcatena := true;
end;

{--------------------------------------------------------}
{                  comando toca
{--------------------------------------------------------}

function processaToca (lido: string): boolean;
var
    retornoMci: array [0..255] of char;
    ficaTocando: boolean;

    procedure sendString (s: string);
    var p: array [0..255] of char;
    begin
        strPcopy (p, s);
        mciSendString (p, retornoMci, 255, 0);
    end;

    procedure toca (nomeArq: string; ficaTocando: boolean);
    begin
        if ficaTocando then
            sendString ('play ' + nomeArq)
        else
            begin
                sendString ('open ' + nomearq + ' alias myfile');
                sendString ('play myfile');
                repeat
                    delay (100);
                    sendString ('status myfile mode');
                until keypressed or (strPas (retornoMci) <> 'playing');
                while keypressed do readkey;

                sendString ('stop myfile');
                sendString ('close myfile');
            end;
    end;

begin
    processaToca := true;
    ficaTocando := false;
    if lido[length(lido)] = '&' then
        begin
            ficaTocando := true;
            delete (lido, length (lido), 1);
            trim (lido);
        end;

    if lido[1] = '"' then
        begin
            delete (lido, 1, 1);
            if lido[length(lido)] = '"' then delete (lido, length(lido), 1);
            toca (lido, ficaTocando);
        end
    else
    if upcase(lido[1]) in ['A'..'Z'] then
        begin
            toca (varScript[upcase(lido[1])]^, ficaTocando);
            delete (lido, 1, 1);
            if lido <> '' then processaToca := false;   { erro }
        end
    else
        processaToca := false;   { erro }
end;

{--------------------------------------------------------}
{                  comando escreve
{--------------------------------------------------------}

function processaEscreve (lido: string): boolean;
var pulaLinha: boolean;
begin
    processaEscreve := true;

    pulaLinha := true;
    if lido[length(lido)] = '&' then
        begin
            pulaLinha := false;
            delete (lido, length (lido), 1);
            trim (lido);
        end;

    if lido = '' then
        writeln
    else
    if lido[1] = '"' then
        begin
            delete (lido, 1, 1);
            if lido[length(lido)] = '"' then delete (lido, length(lido), 1);
            sintWrite (lido);
        end
    else
    if upcase(lido[1]) in ['A'..'Z'] then
        begin
            sintWrite (varScript[upcase(lido[1])]^);
            delete (lido, 1, 1);
            if lido <> '' then processaEscreve := false;   { erro }
        end
    else
        processaEscreve := false;   { erro }

    if pulaLinha then writeln;
    while sintFalando do;
end;

{--------------------------------------------------------}
{                     comando Tela
{--------------------------------------------------------}

function processaTela (lido: string): boolean;
var
    p, x, y, erro: integer;
    s: string;
begin
    processaTela := false;
    if lido = '' then exit;

    lido := maiusc (lido);
    if (length (lido) = 1) and (upcase(lido[1]) in ['A'..'Z']) then
        lido := varScript[upcase(lido[1])]^;

    if lido = 'LIMPA' then
        clrscr
    else
    if lido = 'MINIMIZADA' then
        showWindow (crtWindow, SW_HIDE)
    else
    if lido = 'NORMAL' then
        begin
            showWindow (crtWindow, SW_RESTORE);
            bringWindowToTop (crtWindow);
        end
    else
    if lido [1] = '@' then
        begin
            delete (lido, 1, 1);
            p := pos (',', lido);
            s := copy (lido, 1, p-1);
            trim (s);
            delete (lido, 1, p);
            trim (lido);

            val (s, x, erro);
            if erro <> 0 then exit;
            val (lido, y, erro);
            if erro <> 0 then exit;

            gotoxy (x, y);
        end
    else
        exit;

    processaTela := true;
end;

{--------------------------------------------------------}
{                  comando arquiva
{--------------------------------------------------------}

function processaArquiva (lido: string): boolean;
var pulaLinha: boolean;
    nomeArq: string;
    c: char;
    s: string;

        function escreveArquivo (nomeArq, cadeia: string; pulaLinha: boolean): boolean;
        var arq: text;
        begin
            escreveArquivo := false;

            assign (arq, nomeArq);
            {$I-}  reset (arq); {$I+}
            if ioresult <> 0 then
                begin
                     close (arq);
                     {$I+} append (arq); {$I+}
                end
            else
                {$I-} rewrite (arq);
                if ioresult = 0 then
                    begin
                         if pulaLinha then writeln (arq, cadeia)
                                      else write   (arq, cadeia);
                    end;
                {$I+}
                if ioresult = 0 then
                     escreveArquivo := true;

            {$I-}  close (arq);  {$I+}
            if ioresult <> 0 then;
        end;

begin
    processaArquiva := false;

    pulaLinha := true;
    if lido[length(lido)] = '&' then
        begin
            pulaLinha := false;
            delete (lido, length (lido), 1);
            trim (lido);
        end;

    if not extraiValor (lido, nomeArq) then exit;
    if nomeArq = '' then exit;

    if lido = '' then
        escreveArquivo (nomeArq, '', true)
    else
        begin
            if extraiValor (lido, s) then
                begin
                    if not escreveArquivo (nomeArq, s, pulaLinha) then
                        begin
                            sintWriteln (ERRO_ARQUIVO);  {'Erro de escrita no arquivo'}
                            exit;
                        end;
                end
            else
                exit;
        end;

    processaArquiva := false;   { erro }

    if pulaLinha then writeln (arq);
end;

{--------------------------------------------------------}
{                  comando remove
{--------------------------------------------------------}

function processaRemove (lido: string): boolean;
var
    nomeArq: string;
    arq: file;
    c: char;

begin
    processaRemove := true;
    if lido = '' then
        begin
            processaRemove := false;
            exit;
        end;

    if not extraiValor (lido, nomeArq) then exit;
    if nomeArq = '' then exit;

    if nomeArq = '' then
        begin
            processaRemove := false;
            exit;
        end
    else
        begin
            assign (arq, nomearq);
            {$I-}  erase (arq);  {$I+}
            if ioresult <> 0 then;
        end;
end;

{--------------------------------------------------------}
{                      comando le
{--------------------------------------------------------}

function processaLe (lido: string): boolean;
var
    c: char;
    s, sl: string;
begin
    if lido = '' then
        readln
    else

    if lido [length(lido)] = '&' then
        begin
            delete (lido, length (lido), 1);
            trim (lido);

            if upcase(lido[1]) in ['A'..'Z'] then
                begin
                    c := readKey;

                    if (c > #$32) then
                        s := c
                    else
                    if c = #$0 then
                        begin
                            c := readkey;
                            str (ord(c), s);
                            s := '#0#' + s;
                        end
                    else
                        begin
                            str (ord(c), s);
                            s := '#' + s;
                        end;

                    varScript[upcase(lido[1])]^ := s;
                    delete (lido, 1, 1);
                    if lido <> '' then processaLe := false;   { erro }
                end
            else
                processaLe := false;   { erro }
        end

    else
        begin
            if upcase(lido[1]) in ['A'..'Z'] then
                begin
                    sintReadln (sl);
                    varScript[upcase(lido[1])]^ := sl;
                    delete (lido, 1, 1);
                    if lido <> '' then processaLe := false;   { erro }
                end
            else
                processaLe := false;   { erro }
        end;
end;

{--------------------------------------------------------}
{                  comando cmd
{--------------------------------------------------------}

function processaCmd (lido: string): boolean;   {recursivo, provavelmente}
var s: string;
begin
    processaCmd := false;

    if not extraiValor (lido, s) then exit;
    if lido <> '' then exit;

    cmdScript (s);
    processaCmd := true;
end;

{--------------------------------------------------------}
{                  Comando espera
{--------------------------------------------------------}

function processaEspera (lido: string): boolean;
var erro: integer;
    n: longint;
    s, nomeJan: string;
    titulo: array [0..250] of char;
begin
    processaEspera := false;
    if lido = '' then exit;

    if not (lido[1] in ['0'..'9']) then
        begin
            if not extraiValor (lido, s) then exit;
            val (s, n, erro);
            if erro <> 0 then exit;
        end
    else
        begin
            n := 0;
            repeat
                n := (n * 10)+  (ord(lido[1]) - ord('0'));
                delete (lido, 1, 1);
            until (lido = '') or (not (lido[1] in ['0'..'9']));
        end;

    if (lido <> '') and (lido[1] <> ' ') then exit;

    trim (lido);
    if lido = '' then
        nomeJan := ''
    else
        begin
            if not extraiValor (lido, nomeJan) then exit;
            nomeJan := maiusc (nomeJan);
        end;

    while n > 500 do
        begin
            delay (500);
            if s <> '' then
                begin
                    getWindowText (getActiveWindow, titulo, 250);
                    if pos (nomeJan, maiusc (strPas (titulo))) <> 0 then
                        n := 500;
                end;
            n := n - 500;
        end;
    delay (n);
    processaEspera := true;
end;

{--------------------------------------------------------}
{                  Comando digita
{--------------------------------------------------------}

function processaDigita (lido: string): boolean;
var s: string;
    poeEnter: boolean;
begin
    processaDigita := false;

    poeEnter := true;
    if lido[length(lido)] = '&' then
        begin
            poeEnter := false;
            delete (lido, length (lido), 1);
            trim (lido);
        end;

    if not extraiValor (lido, s) then exit;
    if lido <> '' then exit;

    playInit (300);
    playString (s, 100);
    if poeEnter then
        playVirtKey (VK_RETURN, false, false, false, 50);
    playStart;
    while playIsActive do keypressed;

    processaDigita := true;
end;

{--------------------------------------------------------}
{                  Comando aciona
{--------------------------------------------------------}

function processaAciona (lido: string): boolean;
var s: string;
    letra: char;
    n, erro: integer;
    comCtl, comShift, comAlt: boolean;

begin
    processaAciona := false;
    if not extraiValor (lido, s) then exit;
    if s = '' then exit;
    if lido <> '' then exit;

    if length (s) = 1 then
        keyboardClick (s[1])
    else
        begin
            s := maiusc (s);

            comCtl := false;
            if copy (s, 1, 5) = 'CTRL+' then
                begin
                    comCtl := true;
                    delete (s, 1, 5);
                end;
            comShift := false;
            if copy (s, 1, 6) = 'SHIFT+'   then
                begin
                    comShift := true;
                    delete (s, 1, 6);
                end;

            comAlt := false;
            if copy (s, 1, 4) = 'ALT+'     then
                begin
                    comAlt := true;
                    delete (s, 1, 4);
                end;

            if s = '' then exit;

            if s = 'UP'        then n := VK_UP       else
            if s = 'DOWN'      then n := VK_DOWN     else
            if s = 'LEFT'      then n := VK_LEFT     else
            if s = 'RIGHT'     then n := VK_RIGHT    else
            if s = 'ESCAPE'    then n := VK_ESCAPE   else
            if s = 'ESC'       then n := VK_ESCAPE   else
            if s = 'ENTER'     then n := VK_RETURN   else
            if s = 'RETURN'    then n := VK_RETURN   else
            if s = 'TAB'       then n := VK_TAB      else
            if s = 'F1'        then n := VK_F1       else
            if s = 'F2'        then n := VK_F2       else
            if s = 'F3'        then n := VK_F3       else
            if s = 'F4'        then n := VK_F4       else
            if s = 'F5'        then n := VK_F5       else
            if s = 'F6'        then n := VK_F6       else
            if s = 'F7'        then n := VK_F7       else
            if s = 'F8'        then n := VK_F8       else
            if s = 'F9'        then n := VK_F9       else
            if s = 'F10'       then n := VK_F10      else
            if s = 'F11'       then n := VK_F11      else
            if s = 'F12'       then n := VK_F12      else
            if s = 'INS'       then n := VK_INSERT   else
            if s = 'HOME'      then n := VK_HOME     else
            if s = 'DEL'       then n := VK_DELETE   else
            if s = 'DELETE'    then n := VK_DELETE   else
            if s = 'HOME'      then n := VK_HOME     else
            if s = 'END'       then n := VK_END      else
            if s = 'PAGEUP'    then n := VK_PRIOR    else
            if s = 'PAGEDN'    then n := VK_NEXT     else
            if s = 'PRIOR'     then n := VK_PRIOR    else
            if s = 'NEXT'      then n := VK_NEXT     else
            if s = 'SNAPSHOT'  then n := VK_SNAPSHOT
            else
                begin
                    letra := upcase(s[1]);
                    n := ord (letra);
                    delete (s, 1, 1);
                    if letra = '#' then
                        begin
                            val (s, n, erro);
                            if erro <> 0 then exit;
                        end
                    else
                        if s <> '' then exit;
                end;

            playInit (100);
            playVirtKey (n, comCtl, comShift, comAlt, 100);
            playStart;
            while  playIsActive do;
        end;

    processaAciona := true;
end;

{--------------------------------------------------------}
{                  Comando Clica
{--------------------------------------------------------}

function processaClica (lido: string): boolean;
var rect: TRect;
    s: string;
    p, x, y, xorig, yorig, erro: integer;
begin
    processaClica := false;

    if maiusc (copy (lido, 1, 4)) = 'TELA' then
        begin
            xorig := 0;
            yorig := 0;
            delete (lido, 1, 4);
            trim (lido);
        end
    else
        begin
            getWindowRect (getActiveWindow, rect);
            xorig := rect.left+getSystemMetrics (SM_CXFRAME);
            yorig := rect.top+SM_CYCAPTION;
        end;

    p := pos(',', lido);
    s := copy (lido, 1, p-1);
    trim (s);
    val (s, x, erro);
    if erro <> 0 then exit;

    s := copy (lido, p+1, 999);
    trim (s);
    val (s, y, erro);
    if erro <> 0 then exit;

    mouseClick (x+xorig, y+yorig);
    processaClica := true;
end;

{--------------------------------------------------------}
{                  Comando Obtem
{--------------------------------------------------------}

function processaObtem (lido: string): boolean;
var v: char;
    p: array [0..255] of char;
begin
    processaObtem := false;
    if (lido = '') or (not (upcase(lido[1]) in ['A'..'Z'])) then
        exit;

    v := upcase(lido[1]);
    delete (lido, 1, 1);
    if copy (lido, 1, 1) <> ' ' then exit;
    trim (lido);
    if lido = '' then exit;

    if lido[1] = '"' then
        begin
            delete (lido, 1, 1);
            if lido[length(lido)] = '"' then delete (lido, length(lido), 1);
        end;

    lido := maiusc (lido);
    if (lido = 'TÍTULO') or (lido = 'TITULO') or (lido = 'ATIVA') then
        getWindowText (getActiveWindow, p, 255)
    else
    if (lido = 'FOCO') then
        getWindowText (getFocus, p, 255)
    else
    if (lido = 'CAMPO') then
        begin
            playInit (100);
            playVirtKey (VK_HOME, false, false, false, 100);
            playVirtKey (VK_END, false, true, false, 100);
            playVirtKey (VK_INSERT, true, false, false, 100);
            playStart;
            while  playIsActive do;
            getClipBoard (p, 255);
        end;

    varScript[v]^ := strPas (p);
    processaObtem := true;
end;

{--------------------------------------------------------}
{                  Comando janela
{--------------------------------------------------------}

function processaJanela (lido: string): boolean;
var
    currWnd: hwnd;
    txt: array [0..144] of char;
    p: integer;
    titulo, s: string;
    aoInicio, aoFim, visivel, iconica: boolean;

label prox, achou;

begin
    processaJanela := false;

    if lido = '' then exit;
    if not extraiValor (lido, s) then exit;

    s := maiusc (s);
    if (s = '&') or (s = '&&')then exit;
    aoInicio := true;
    if s[1] = '&' then
        begin
            aoInicio := false;
            delete (s, 1, 1);
        end;
    aoFim := true;
    if s[length (s)] = '&' then
        begin
            aoFim := false;
            delete (s, length(s), 1);
        end;

    CurrWnd := GetWindow(crtWindow, GW_HWNDFIRST);

    While CurrWnd <> 0 do
        begin
            if isWindowEnabled (currWnd) then
                begin
                    visivel := isWindowVisible (currWnd);
                    iconica := isIconic (currWnd);
                    GetWindowText(CurrWnd, txt, 144);
                    titulo := maiusc (strPas (txt));

                    if ((visivel or iconica) and (length (titulo) <> 0)) then
                        begin
                            p := pos (s, titulo);
                            if (p = 0)  or
                               ((p <> 1) and aoInicio) or
                               ((p <> (length(titulo) - length(s) + 1)) and aoFim) then
                                          goto prox;

                            goto achou;
                        end;
                end;
prox:
           CurrWnd := GetWindow(CurrWnd, GW_HWNDNEXT);
        end;

    processaJanela := true;
    exit;   { não achou }

achou:
    trim (lido);
    if (maiusc (lido) = 'FECHA') then
        sendMessage (currWnd, WM_CLOSE, 0, 0)
    else
    if (lido = '') or (maiusc (lido) = 'NORMAL') then
        begin
            ShowWindow(currWnd, SW_SHOWNORMAL);
            setActiveWindow (currWnd);
        end
    else
    if maiusc (lido) = 'MAXIMIZA' then
        begin
            ShowWindow(currWnd, SW_MAXIMIZE);
            setActiveWindow (currWnd);
        end
    else
    if maiusc (lido) = 'MINIMIZA' then
        ShowWindow(currWnd, SW_MINIMIZE)
    else
        exit;

    processaJanela := true;
end;

{--------------------------------------------------------}
{                  Comando desvia
{--------------------------------------------------------}

function processaDesvia (lido: string): boolean;
var s: string;
begin
    processaDesvia := false;
    if fimProc then exit;   { processamento fora de arquivo }
    if lido = '' then exit;

    if lido[1] = '@' then
        begin
            delete (lido, 1, 1);
            s := lido;
            if pos (' ', s) <> 0 then exit;  {rotulo com brancos}
        end
    else
        begin
            if not extraiValor (lido, s) then exit;
            if lido <> '' then exit;
        end;

    processaDesvia := buscaRotulo (s);
end;

{--------------------------------------------------------}
{                  Comando se
{--------------------------------------------------------}

function processaSe (lido: string): boolean;
var valor1, valor2, mv1, mv2: string;
    operador: string[3];
    v: char;
label ok, fim;
begin
    processaSe := false;
    if lido = '' then exit;

    v := upcase(lido[1]);
    if not (v in ['A'..'Z']) then exit;
    valor1 := varScript[v]^;

    delete (lido, 1, 1);
    trim (lido);
    if lido = '' then exit;

    if copy (lido, 1, 2) = '>='  then operador := '>='  else
    if copy (lido, 1, 2) = '<='  then operador := '<='  else
    if copy (lido, 1, 2) = '=='  then operador := '=='  else
    if copy (lido, 1, 2) = '<>'  then operador := '<>'  else
    if copy (lido, 1, 3) = '*=*' then operador := '*=*' else
    if copy (lido, 1, 2) = '=*'  then operador := '=*'  else
    if copy (lido, 1, 2) = '*='  then operador := '*='  else
    if lido[1] = '=' then operador := '=' else
    if lido[1] = '<' then operador := '<' else
    if lido[1] = '>' then operador := '>'
    else
        exit;

    delete (lido, 1, length (operador));
    trim (lido);
    if lido = '' then exit;

    if not extraiValor (lido, valor2) then exit;
    if lido = '' then exit;    { faltou comando a executar }

    mv1 := maiusc(valor1);
    mv2 := maiusc(valor2);

    if (operador = '=')  and (mv1 = mv2) then goto ok;
    if (operador = '<')  and (mv1 < mv2) then goto ok;
    if (operador = '>')  and (mv1 > mv2) then goto ok;

    if (operador = '==') and (valor1 = valor2)    then goto ok;
    if (operador = '<=') and (mv1 <= mv2)         then goto ok;
    if (operador = '>=') and (mv1 >= mv2)         then goto ok;
    if (operador = '<>') and (mv1 <> mv2)         then goto ok;

    if (operador = '*=*') and (pos (mv2, mv1) <> 0) then goto ok;
    if (operador = '=*')  and (pos (mv2, mv1) = 1)  then goto ok;
    if (operador = '*=')  and
          (pos (mv2, mv1) = length(valor1)-length(valor2)+1) then goto ok;
    goto fim;

ok:
    cmdScript (lido);
fim:
    processaSe := true;
end;

{--------------------------------------------------------}
{                  Comando executa
{--------------------------------------------------------}

function processaExecuta (lido: string): boolean;
var comando, param, nomeDir: string;
    espera: boolean;
    i: integer;
begin
    processaExecuta := false;

    espera := true;
    if (lido <> '') and (lido [length(lido)] = '&') then
        begin
            espera := false;
            delete (lido, length (lido), 1);
            trim (lido);
        end;

    if not extraiValor (lido, comando) then exit;
    if lido <> '' then exit;

    getdir (0, nomeDir);
    i := pos (' ', comando);
    if i = 0 then
        param := ''
    else
        begin
            param := copy (comando, i+1, 999);
            delete (comando, i, 999);
        end;

    while sintFalando do;
    if executaProg (comando, nomeDir, param) >= 32 then
        begin
            if espera then esperaProgVoltar;
        end
    else
        exit;

    processaExecuta := true;
end;

{--------------------------------------------------------}
{                  Comando Termina
{--------------------------------------------------------}

function processaTermina (lido: string): boolean;
begin
    fimProc := true;
    if maiusc(lido) = 'MUDO' then
        mudo := true;
    processaTermina := true;
end;

{--------------------------------------------------------}
{                  Comando chama
{--------------------------------------------------------}

function processaChama (lido: string): boolean;
var s: string;
begin
    processaChama := false;
    if fimProc then exit;   { processamento fora de arquivo }
    if lido = '' then exit;

    if lido[1] = '@' then
        begin
            delete (lido, 1, 1);
            s := lido;
            if pos (' ', s) <> 0 then exit;  {rotulo com brancos}
        end
    else
        begin
            if not extraiValor (lido, s) then exit;
            if lido <> '' then exit;
        end;

    if topoRetorno < MAXRETORNO then
        begin
            topoRetorno := topoRetorno + 1;
            pilhaRetorno[topoRetorno] := linhaAtual;
        end
    else
        begin
            sintWriteln (STACK_OVERFLOW);  {'Muitas chamadas sem retorno'}
            exit;
        end;

    processaChama := buscaRotulo (s);
end;

{--------------------------------------------------------}
{                  Comando
{--------------------------------------------------------}

function processaRetorna (lido: string): boolean;
begin
    processaRetorna := false;
    if lido <> '' then exit;

    if topoRetorno = 0 then
        begin
            sintWriteln (STACK_UNDERFLOW);  {'Retorno sem chamada'}
            exit;
        end;

    linhaAtual := pilhaRetorno[topoRetorno];
    topoRetorno := topoRetorno -1;

    processaRetorna := true;
end;

{--------------------------------------------------------}
{             executa um comando do script
{--------------------------------------------------------}

function executaComando (cmd, lido: string): boolean;
var i: integer;
begin
    if cmd = '' then
        begin
            executaComando := false;
            exit;
        end;

    executaComando := true;

    trim (lido);
    if debug then
        sintWriteln (cmd + ' ' + lido);

    for i := 1 to length (cmd) do
        cmd[i] := upcase (cmd[i]);

    if cmd = 'DEBUG'     then executaComando := processaDebug (lido)
    else
    if cmd = 'SEJA'      then executaComando := processaSeja (lido)
    else
    if cmd = 'TELA'      then executaComando := processaTela (lido)
    else
    if cmd = 'ESCREVE'   then executaComando := processaEscreve (lido)
    else
    if cmd = 'SOMA'      then executaComando := processaSoma (lido)
    else
    if cmd = 'CONCATENA' then executaComando := processaConcatena (lido)
    else
    if cmd = 'TOCA'      then executaComando := processaToca (lido)
    else
    if cmd = 'LE'        then executaComando := processaLe (lido)
    else
    if cmd = 'ARQUIVA'   then executaComando := processaArquiva (lido)
    else
    if cmd = 'REMOVE'    then executaComando := processaRemove (lido)
    else
    if cmd = 'CMD'       then executaComando := processaCmd (lido)
    else
    if cmd = 'ESPERA'    then executaComando := processaEspera (lido)
    else
    if cmd = 'DIGITA'    then executaComando := processaDigita (lido)
    else
    if cmd = 'ACIONA'    then executaComando := processaAciona (lido)
    else
    if cmd = 'CLICA'     then executaComando := processaClica (lido)
    else
    if cmd = 'OBTEM'     then executaComando := processaObtem (lido)
    else
    if cmd = 'JANELA'    then executaComando := processaJanela (lido)
    else
    if cmd = 'DESVIA'    then executaComando := processaDesvia (lido)
    else
    if cmd = 'SE'        then executaComando := processaSe (lido)
    else
    if cmd = 'EXECUTA'   then executaComando := processaExecuta (lido)
    else
    if cmd = 'TERMINA'   then executaComando := processaTermina (lido)
    else
    if cmd = 'CHAMA'     then executaComando := processaChama (lido)
    else
    if cmd = 'RETORNA'   then executaComando := processaRetorna (lido)
    else
        begin
            executaComando := false;
            sintWriteln (COMANDO_INVALIDO + cmd);   {'Comando inválido: '}
        end;
end;

{--------------------------------------------------------}
{                executa uma linha
{--------------------------------------------------------}

function cmdScript (lido: string): boolean;
var c: char;
begin
    trim (lido);
    if (lido = '') or (lido[1] = '*') or (lido[1] = '@') then
        exit;

    cmd := '';
    repeat
        c := upcase (lido [1]);
        delete (lido, 1, 1);
        if c <> ' ' then
            cmd := cmd + upcase (c);
    until (c = ' ') or (lido = '');

    erroProc := not executaComando (cmd, lido);
    cmdScript := not erroProc;
end;

{--------------------------------------------------------}
{                executa todo script
{--------------------------------------------------------}

function executaScript (nomeArq, rotulo: string; var ultLinhaProc: integer): integer;
var
    lido: string;

begin
    if not carregaScript (nomeArq) then
        begin
            executaScript := SCR_SEMARQUIVO;
            exit;
        end;

    linhaAtual := 1;
    erroProc := false;
    fimProc := false;
    cmd := '';
    mudo := false;
    topoRetorno := 0;

    if rotulo <> '' then
        if not buscaRotulo (rotulo) then
            executaScript := SCR_ROTULOINVALIDO;

    while (linhaAtual <= nLinhasScript) and (not fimProc) and (not erroProc) do
        begin
            lido := script^[linhaAtual]^;
            cmdScript (lido);
            if (not fimProc) and (not erroProc) then
                linhaAtual := linhaAtual + 1;
        end;

    liberaScript;
    ultLinhaProc := linhaAtual;
    if erroProc then
        executaScript := SCR_ERROEXEC
    else
        executaScript := SCR_OK;
end;

var c: char;
begin
    for c := 'A' to 'Z' do
        begin
            new (varScript[c]);
            varScript[c]^:= '';
        end;

    fimProc := true;
    delay (1);   { estabilizador de processamento virtual }
end.
