Delphi dicas

Io: acessar a porta paralela do micro

{

Enviar e receber Informações da porta paralela do Micro

pode haver alguma restrição no XP, se tiver o xp não tem esta restrição para programas que rodam em modo DOS. Já testei.



Caso queira fazer uma aplicação a nivel de hardware é preciso conhecer o funcionamento da porta paralela, que pode ser queimada muito facilmente... ela envia e recebe dados nos 8 pinos de dados e cada pino com uma entrada e saida de  5 volts



quando você envia um byte para esta porta ele fica "ligado" até que você mande outro byte para apagalo.



}

procedure sendport(bty:byte);

asm

        mov al, bty;

        mov dx, $378 ;

        out dx, al;

end;





function GetPort:word;

var

bValue: byte;

begin

        asm

                mov dx, $378;

                in al, dx;

                mov bValue, al;

        end;

        GetPort := bValue;

end;



{

Caso for necessario o uso do Dos em baixo segue um programa para turbo pascal

que controla uma arvore de natal pela porta paralela do micro.

você tem que criar um diretório chamado "C:Arvore"

e dentro dele colocar um arquivo que se chama padrao.dat

e dentro do arquivo os bytes que vc quer jogar na porta, EX:

01000110

11111111

00000000

11101010

se você der um esc

ele irá pedir outro arquivo e outra velocidade.

}



//Criação: João Bosco da Silva (hardware)

//            Adalton Martins Gomes (SoftWare)



program arvore;

uses crt;

var pausa:integer;

nome_arq:string;

arq:text;

label repete;



function power(base:integer;expoente:integer):integer;

var cont, result:integer;



begin

        result:=1;

        for cont:=1 to expoente do

        result:=result*base;

        power:=result;

end;



function BinToInt(Valor: string): byte;

var

i, Tamanho, np, code: integer;

result:byte;

begin

        result := 0;

        Tamanho := Length(Valor);

        for i := 0 to Tamanho - 1 do

        begin

                val(Valor[Tamanho - i],np,code);

                result := result + np * Trunc(Power(2, i));

        end;

        BinToInt:=result;

end;



function fileexiste(arqs:string):byte;

var result:byte;

begin

        result:=0;

        ASSIGN(arq,NOME_ARQ);

        {$I-}

        RESET(ARQ);

        {$i+}

        IF IORESULT <> 0 THEN

        begin

                result:=0;

                sound(300);

                asm

                        mov al, 255

                        mov dx, $378

                        out dx, al

                end;

                delay(5000);

                nosound;

                asm

                        mov al, 00

                        mov dx, $378

                        out dx, al

                end;

        end

        else begin

                result:=1;

                close(arq);

        end;

        fileexiste:=result;

end;



procedure new_file;

var p:string;

code:integer;

begin

        asm

                mov al, 00000000

                mov dx, $378

                out dx, al

        end;

        repeat

                clrscr;

                write('Nome do Arquivo: ');

                readln(nome_arq);

                if nome_arq ='fim'then

                exit;

                if pos('.',nome_arq)=0 then

                nome_arq:=nome_arq+'.dat';

        until fileexiste(nome_arq)=1;

        write('Insira o valor da Pausa: ');

        repeat

                gotoxy(25,2);

                clreol;

                readln(p);

                val(p,pausa,code);

                if code<>0 then

                begin

                        sound(300);

                        asm

                                mov al, 255

                                mov dx, $378

                                out dx, al

                        end;

                        delay(1000);

                        nosound;

                        asm

                                mov al, 00

                                mov dx, $378

                                out dx, al

                        end;

                end;

        until code=0;

end;



procedure send_arvore;

var byt:byte;

code,numero:integer;

stop:char;

linha:string;

begin

        stop:=#0;

        assign(arq,nome_arq);

        repeat

                reset(arq);

                while (not eof(arq)) and not(stop=#27) do

                begin

                        delay(pausa);

                        readln(arq,linha);

                        val(linha,numero,code);

                        if code=0 then

                        begin

                                byt:=BinToInt(linha);

                                asm

                                        mov al, byt

                                        mov dx, $378

                                        out dx, al

                                end;

                        end;

                        write(linha+' ');writeln(byt);

                        if keypressed then

                        stop:=readkey;

                end;

                close(arq);

        until stop=#27;

        new_file;

end;



begin

        clrscr;

        chdir('c:arvore');

        nome_arq:='padrao.dat';

        pausa:=100;

        repete:

        send_arvore;

        if nome_arq <>'fim' then

        goto repete;

end.

por : Adalton Martins Gomes