Quelques programmes utilisant ces pilotes

(menu Pilotes DOS)
 
  • Un programme testant l'existence d'un pilote
    1. program test;
      uses dos,crt;
      var i:byte;

      function testepilote(numint:byte):boolean;
      var lpointeur:pointer;
      begin

        getintvec(numint,lpointeur);
        testepilote:=memw[seg(lpointeur^):06]=$ABCD
      end;

      begin

        writeln('Quel est le numéro de l''interruption à tester ?);
        readln(i);
        if testepilote(i)
          then writeln('il y a un pilote');
          else writeln('il n''y a pas de pilote');
      end.
       
    2. Exploration des différentes fonctions d'un pilote

    3. program testefonctions;
      uses dos,crt;
      const numint=$FA;
      var nomlu:string;
      numero:word;

      function litnomfonction(numint:byte;numfonction:word):string;
      var compteur:word;
      nom: string;
      regs:registers;
      begin

        compteur:=0;nom:='';
        repeat
          inc(compteur);
          regs.ax:=numfonction;regs.cx:=compteur;
          intr(numint,regs);
          if regs.bx>0 then nom:=nom+chr(regs.bx);
        until regs.bx=0;
        litnomfonction:=nom;
      end;
         
      begin (*programme principal*)
        numero:=0;
        repeat
          nomlu:=litnomfonction(numint,numero);
          if nomlu<>''
              then writeln('numéro de fonction :',numero,' nom : ',nomlu);
          numero :=numero+1;
        until keypressed;
      end.
       
    4. Programme testant les différentes fonctions

    5. program mesure;
      uses dos,crt;
      const numint:byte=$FA;
      var reponse : string;
      repchar:array[0..80] of char;
      bascule:boolean;
      nombrechoisi,indice:byte;
      carchoisi:char;
      regs:registers;
      numero,erreur:word;

      procedure lireEA;
      var i:byte;
      begin

        repeat
        for i:=0 to 3 do
          begin
            regs.ax:=i;
            regs.cx:=0;
            intr(numint,regs);
            write(regs.bx);
          end;
        writeln;
        until keypressed
      end;

      procedure fixerSA;
      var valeur:integer;
      begin

        writeln('Quelle va être la valeur à envoyer au CNA ?');
        readln(valeur);
        regs.ax:=1000;
        regs.bx:=valeur;
        regs.cx:=0;
        intr(numint,regs);
      end;

      procedure lireEL;
      var i,resultat:byte;
      begin

        repeat
          for i:=0 to 3 do
          begin
            regs.ax:=2000+i;
            regs.cx:=0;
            intr(numint,regs);
            resultat:=regs.bx;
            if resultat=0 then write('faux') else write('vrai');
          end;
          writeln;
        until keypressed;
      end;

      procedure fixerSL(etat:boolean);
      var octetlocal:byte;
      begin

        writeln('Quel numéro (de 0 à 3) ?');
        readln(octetlocal);
        regs.ax:=3000+octetlocal;
        regs.cx:=0;
        if etat then regs.bx:=1 else regs.bx:=0;
        intr(numint,regs);
      end;

      begin (*programme principal*)

        if paramcount>0 then
        begin
          val(paramstr(1),numero,erreur);
          if erreur = 0
              then numint:=numero
              else begin writeln('erreur'); halt(1);end;
        end;
        repeat
          clrscr;
          writeln('Test des pilotes exécutables résidant en mémoire');
          writeln;
          writeln('choisissez votre option');
          writeln('-1- : lire les entrées analogiques 1 à 4');
          writeln('-2- : fixer la sortie analogique 1');
          writeln('-3- : lire les entrées logiques 1 à 4');
          writeln('-4- : fixer une sortie logique à l''état "vrai"');
          writeln('-5- : fixer une sortie logique à l''état "faux"');
          writeln('-6- : arrêter ce programme de test');
          carchoisi:=readkey;
          case carchoisi of
            '1' : lireEA;
            '2' : fixerSA;
            '3' : lireEL;
            '4' : fixerSL(true);
            '5' : fixerSL(false);
               end;
           until carchoisi='6';
      end.