João Túlio

Irei mandar o código eu acabei modularizando mais o programa principal, porém meu professor mandou criar um vetor mas nao disse que deveria ser útil no programa então criei um vetor apenas para atribuir as situação do veículo, porém tem um problema meu código, quando o usuario registra em letras minúsculas para buscar o usuário teria que escrever também em minúsculas, mas segue o código.

program BuscaPlacas300;

uses
  UnitBuscaPlacas3000,crt;

begin
  NomeArq := 'BuscaPlacas3000.bin';
  cabecalho();
  readln;
  ClrScr();
  AbreArquivo(Arq, NomeArq);
  repeat
    TelaInicio();//TELA DE ESCOLHAS DE OPÇÔES DO USUÀRIO
    A := Val1(EscolhaInicio);
    //Chamando a Função para validar o que foi digitado pelo usuário
    case A of
      1:   //Caso o usuário digite 1 entao ira buscar os arquivos já registrados
      begin
        repeat
          ClrScr();
          Writeln('Escolha uma das opções abaixo ');
          Writeln('1 - Buscar/Continuar Buscando ');
          writeln('2 - Parar');
          readln(Parar);

          C := val3(Parar); //Validando o valor digitado

          if C = 1 then
          begin
            LeituraBusca();//Informações para ler e buscar
            Indice1 := BuscaArquivo1(Arq, Carro.Placa);
            //Chamando o procedimento de buscar arquivos
            condicao1();

          end;

        until parar = '2';  //O programa ira parar de procurar quando o usuario digitar 2
        Close(Arq);
        ClrScr();
      end;
      2:  //CASO SEJA 2 IRÀ REGISTRAR
      begin
        ClrScr();
        repeat
          ClrScr();
          Writeln('Escolha uma das opções abaixo ');
          Writeln('1 - Registrar/Continuar registrando ');
          writeln('2 - Parar de Registrar ');
          readln(Parar);

          C := val3(Parar); //VALIDANDO NUMERO
          if C = 1 then
          begin
            ClrScr();
            Leitura();//PROCEDIMENTO DE LEITURA DOS DADOS
            AdicionaArquivo(Arq, Carro);//ADICIONANDO ARQUIVO .bin
          end;
        until parar = '2';
        Close(Arq);
        ClrScr();
      end;
    end;
  until EscolhaInicio = '3';

end.

UNIT

unit UnitBuscaPlacas3000;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, crt;

type

  TCarro = record
    Placa: string[7];
    chassi: string[17];
    situacao: array[1..2] of string[30];
  end;
  TArq = file of TCarro;

var
  EscolhaInicio, EscolhaSituacao, Parar, NomeArq: string;
  A, B, C, Indice1, Indice2: integer;
  Arq: TArq;
  Carro: TCarro;

procedure Cabecalho();
procedure TelaInicio();
function Val1(Mensagem: string): integer;
function Val2(Mensagem: string): integer;
function Val3(Mensagem: string): integer;
procedure AbreArquivo(var Arq: TArq; NomeArq: string);
procedure AdicionaArquivo(var Arq: TArq; A: TCarro);
procedure Leitura();
procedure LeituraBusca();
procedure EscrevaBusca1();
procedure EscrevaBusca2();
function BuscaArquivo1(var Arq: Tarq; Placa: string): integer;
function BuscaArquivo2(var Arq: Tarq; Chassi: string): integer;
procedure Condicao1();

implementation

procedure Cabecalho();
begin
  TextColor(red);
  writeln('****** BEM-VINDO AO BUSCA PLACAS 3000 ****** ');
  TextColor(white);
end;

procedure TelaInicio();
begin
  ClrScr();
  writeln('Esolha o que deseja realizar: ');
  writeln('1 - Buscar Placas ');
  writeln('2 - Registrar Placa ');
  Writeln('3 - Fechar ');
  readln(EscolhaInicio);

end;

function Val1(Mensagem: string): integer;
var
  Valor, Erro: integer;
begin
  repeat
    val(Mensagem, Valor, Erro);
    if Erro <> 0 then
    begin
      Writeln('Numero Inválido, Digite novamente ');
      readln(Mensagem);
    end;
    repeat
      if (Valor < 1) or (Valor > 3) then
      begin
        writeln('Número Inválido, Digite novamente ');
        readln(Mensagem);
        val(Mensagem, Valor, Erro);
      end;
    until (Valor >= 1) and (Valor <= 3);
  until (Erro = 0);
  Val1 := Valor;
end;

function Val2(Mensagem: string): integer;
var
  Valor, Erro: integer;
begin
  repeat
    val(Mensagem, Valor, Erro);
    if Erro <> 0 then
    begin
      Writeln('Numero Inválido, Digite novamente ');
      readln(Mensagem);
    end;
    repeat
      if (Valor < 1) and (Valor > 2) then
      begin
        writeln('Número Inválido,Digite novamente ');
        readln(Mensagem);
        val(Mensagem, Valor, Erro);
      end;
    until (Valor = 1) or (Valor = 2);
  until (Erro = 0) and (Valor = 1) or (Valor = 2);
  Val2 := Valor;
end;

function Val3(Mensagem: string): integer;
var
  Valor, Erro: integer;
begin
  repeat
    val(Mensagem, Valor, Erro);
    if Erro <> 0 then
    begin
      Writeln('Numero Inválido, Digite novamente ');
      readln(Mensagem);
    end;
    repeat
      if (Valor < 1) or (Valor > 2) then
      begin
        writeln('Número Inválido,Digite novamente ');
        readln(Mensagem);
        val(Mensagem, Valor, Erro);
      end;
    until (Valor = 1) or (Valor = 2);
  until (Erro = 0) and (Valor = 1) or (Valor = 2);
  Val3 := Valor;
end;

procedure AbreArquivo(var Arq: TArq; NomeArq: string);
begin
  Assign(Arq, NomeArq);
  if FileExists(NomeArq) then
  begin
    Reset(Arq);
  end
  else
  begin
    Rewrite(Arq);
  end;
end;

procedure AdicionaArquivo(var Arq: TArq; A: TCarro);
begin
  Seek(Arq, FileSize(Arq));
  Write(Arq, A);
  Seek(Arq, FileSize(Arq) - 1);
end;

procedure Leitura();
begin
  Writeln('Informe a placa do Carro ');
  readln(Carro.Placa);
  WRiteLn('Informe o chassi do carro ');
  readln(Carro.chassi);
  Writeln('Escolha a Situação do Veículo: ');
  Writeln('1 - Roubado/Furtado ');
  WriteLn('2 - Sem ocorrências ');
  readln(EscolhaSituacao);
  B := val2(EscolhaSituacao);
  case B of
    1:
    begin
      Carro.situacao[1] := 'Roubado/Furtado ';
      Carro.situacao[2] := 'Roubado/Furtado ';
    end;
    2:
    begin
      Carro.situacao[1] := 'Sem ocorrências ';
      Carro.situacao[2] := 'Sem ocorrências ';
    end;
    else
    begin
      Carro.Situacao[1] := '~Nao definida~ ';
      Carro.situacao[2] := '~Nao definida~ ';
    end;
  end;
end;

procedure LeituraBusca();
begin
  ClrScr();
  Writeln('Informe a placa ou o chassi para buscar o carro: ');
  writeln('Aperte enter caso nao saiba algum dos campos ');
  writeln();
  Writeln('Placa: ');
  readln(Carro.Placa);
  WriteLn('Chassi: ');
  readln(Carro.chassi);
end;

procedure EscrevaBusca1();
begin
  Seek(Arq, Indice1);//Buscando o arquivo da posição desejada
  Read(Arq, Carro);
  TextColor(Red);
  WriteLn('Dados encontrados: ');
  Writeln('Placa: ', Carro.Placa);
  Writeln('Chassi: ', Carro.chassi);
  Writeln('Situação: ', Carro.situacao[1]);
  TextColor(White);
  readln;
end;

procedure EscrevaBusca2();
begin
  Seek(Arq, Indice2);//Buscando o arquivo da posição desejada
  Read(Arq, Carro);
  TextColor(Red);
  Writeln('Dados encontrados: ');
  Writeln('Placa: ', Carro.Placa);
  Writeln('Chassi: ', Carro.chassi);
  Writeln('Situação: ', Carro.situacao[1]);
  TextColor(White);
  readln;
end;

function BuscaArquivo1(var Arq: Tarq; Placa: string): integer;
var
  A: TCarro;
  Posicao: integer;
begin
  Posicao := -1;
  Seek(Arq, 0);
  repeat
    Read(Arq, A);
    if (A.placa = Placa) then
    begin
      Posicao := FilePos(Arq) - 1;
    end;
  until (EOF(Arq)) or (Posicao <> -1);
  BuscaArquivo1 := Posicao;
end;

function BuscaArquivo2(var Arq: Tarq; Chassi: string): integer;
var
  A: TCarro;
  Posicao: integer;
begin
  Posicao := -1;
  Seek(Arq, 0);
  repeat
    Read(Arq, A);
    if (A.chassi = chassi) then
    begin
      Posicao := FilePos(Arq) - 1;
    end;
  until (EOF(Arq)) or (Posicao <> -1);
  BuscaArquivo2 := Posicao;
end;

procedure Condicao1();
begin
  if (Indice1 <> -1) then
  begin
    EscrevaBusca1();
  end
  else
  begin
    Indice2 := BuscaArquivo2(Arq, Carro.Chassi);
    //BUSCANDO DADOS NOS ARQUIVOS
    if (Indice2 <> -1) then
    begin
      EscrevaBusca2(); //ESCREVENDO DADOS ENCONTRADOS
    end
    else
    begin
      Writeln('Registro nao encontrado ');
      readln();
    end;
  end;
end;

end.

BuscaPlacas3000.rar

Muito obrigado conseguir resolver e aprimorar o programa

Olá pessoal estou fazendo um programa no qual registra placas, chassis e informa a situação do veículo, porém, não estou conseguindo buscar as placas ou o chassi para informar a situação do veículo. OBS: Deixei a pasta do arquivo para baixarem, eu uso o Lazarus para programar.

program BuscaPlacas;

uses UnitPlacas,crt;

var
   EscolhaInicio,EscolhaSituacao,Parar,NomeArq : string;
   A,B,C,Indice1 : integer;
   Arq : TArq;
   Carro: TCarro;

begin
  NomeArq := 'BuscaPlacas3000.bin';
  cabecalho();
  readln;
  ClrScr();
  AbreArquivo(Arq, NomeArq);
  repeat
  writeln('Esolha o que deseja realizar: ');
  writeln('1 - Buscar Placas ');
  writeln('2 - Registrar Placa ');
  Writeln('3 - Fechar ');
  readln(EscolhaInicio);

  //Chamando a Função para validar o que foi digitado pelo usuário
   A := Val1(EscolhaInicio);


  case A of
     1:   //Caso o usuário digite 1 entao ira buscar os arquivos já registrados
     begin

        repeat
           ClrScr();
           Writeln('Escolha uma das opções abaixo ');
           Writeln('1 - Continuar Buscando/Buscar ');
           writeln('2 - Parar');
           readln(Parar);
           C:= val3(Parar); //Validando o valor digitado
           if C = 1 then begin
              ClrScr();
              Writeln('Informe a placa ou o chassi para buscar o carro: ');
              writeln('Aperte enter caso nao saiba algum dos campos ');
              writeln();
              Writeln('Placa: ');
              readln(Carro.Placa);
              WriteLn('Chassi: ');
              readln(Carro.chassi);
              Indice1 := BuscaArquivo1(Arq,Carro.Placa);   //Chamando o procedimento de buscar arquivos
              if (Indice1 <> -1) then begin
                 Seek(Arq,Indice1);//Buscando o arquivo da posição desejada
                 Read(Arq,Carro);
                 TextColor(Red);
                 Writeln('Placa: ',Carro.Placa,'  Chassi: ',Carro.chassi,'  Situação: ',Carro.situacao);
                 TextColor(White);
                 readln;
              end else begin
                 Writeln('Registro não encontrado ');
              end;
           end;
        until parar = '2';  //O programa ira parar de procurar quando o usuario digitar 2
        Close(Arq);
        ClrScr();
     end;
     2:  //PROCEDIMENTOS PARA REGISTRAR OS VEICULOS
     begin
        ClrScr();
        repeat
           Writeln('Escolha uma das opções abaixo ');
           Writeln('1 - Continuar Registrando/Registrar ');
           writeln('2 - Parar de Registrar ');
           readln(Parar);
           C:=val3(Parar);
           if C = 1 then begin
              repeat
              ClrScr();
              Writeln('Informe a placa do Carro ');
              readln(Carro.Placa);
              AdicionaArquivo(Arq,Carro);
              WRiteLn('Informe o chassi do carro ');
              readln(Carro.chassi);
              AdicionaArquivo(Arq,Carro);
              Writeln('Escolha a Situação do Veículo: ');
              Writeln('1 - Roubado/Furtado ');
              WriteLn('2 - Sem ocorrências ');
              readln(EscolhaSituacao);
              B := val2(EscolhaSituacao);
              if B = 1 then
                 Carro.situacao:='Roubado/Furtado';
                 AdicionaArquivo(Arq,Carro);
                 ClrScr();
              if B = 2 then
                 Carro.situacao:='Sem ocorrências';
                 AdicionaArquivo(Arq,Carro);
                 ClrScr();
           end;
        until parar = '2';
        Close(Arq);
     end;

  end;
  until EscolhaInicio = '3';

end.

unit UnitPlacas;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,crt;

type

  TCarro = record
    Placa : string[7];
    chassi : string[17];
    situacao : string[30];
  end;
  TArq = file of TCarro;



procedure Cabecalho();
function Val1(Mensagem : string):integer;
function Val2(Mensagem : string):integer;
function Val3(Mensagem: string): integer;
//Estrutura de Arquivos
procedure AbreArquivo(var Arq: TArq; NomeArq: string);
procedure AdicionaArquivo(var Arq: TArq; A: TCarro);
function BuscaArquivo1(var Arq: Tarq; Placa: string): integer;

implementation

procedure Cabecalho();
begin
   TextColor(red);
   writeln('****** BEM-VINDO AO BUSCA PLACAS 3000 ****** ');
   TextColor(white);
end;

//Laço de repetição para forçar o usuário a digitar um número válido

function Val1(Mensagem: string): integer;
var
  Valor,Erro:integer;
begin
  repeat
     val(Mensagem,Valor,Erro);
     if Erro <> 0 then begin
        Writeln('Numero Inválido, Digite novamente ');
        readln(Mensagem);
     end;
     repeat
        if (Valor < 1) or (Valor > 3) then
        begin
           writeln('Número Inválido, Digite novamente ');
           readln(Mensagem);
           val(Mensagem,Valor,Erro);
        end;
     until (Valor >=1) and (Valor <= 3);
  until (Erro = 0);
  Val1 := Valor;
end;

function Val2(Mensagem: string): integer;
var
  Valor,Erro :integer;
begin
  repeat
     val(Mensagem,Valor,Erro);
     if Erro <> 0 then begin
        Writeln('Numero Inválido, Digite novamente ');
        readln(Mensagem);
     end;
     repeat
        if (Valor <1) and (Valor > 2) then
        begin
           writeln('Número Inválido,Digite novamente ');
           readln(Mensagem);
           val(Mensagem,Valor,Erro);
        end;
     until (Valor = 1) or (Valor = 2);
  until (Erro = 0) and (Valor = 1) or (Valor = 2);
  Val2 := Valor;
end;

function Val3(Mensagem: string): integer;
var
  Valor,Erro :integer;
begin
  repeat
     val(Mensagem,Valor,Erro);
     if Erro <> 0 then begin
        Writeln('Numero Inválido, Digite novamente ');
        readln(Mensagem);
     end;
     repeat
        if (Valor <1) or (Valor > 2) then
        begin
           writeln('Número Inválido,Digite novamente ');
           readln(Mensagem);
           val(Mensagem,Valor,Erro);
        end;
     until (Valor = 1) or (Valor = 2);
  until (Erro = 0) and (Valor = 1) or (Valor = 2);
  Val3 := Valor;
end;

procedure AbreArquivo(var Arq: TArq; NomeArq: string);
begin
  Assign(Arq, NomeArq);
  if FileExists(NomeArq) then begin
     Reset(Arq);
  end else begin
    Rewrite(Arq);
  end;
end;

procedure AdicionaArquivo(var Arq: TArq; A: TCarro);
begin
  Seek(Arq, FileSize(Arq));
  Write(Arq, A);
  Seek(Arq, FileSize(Arq) - 1);
end;

function BuscaArquivo1(var Arq: Tarq; Placa: string): integer;
var
  A: TCarro;
  Posicao: integer;
begin
   Posicao := -1;
   Seek(Arq,0);
   repeat
      Read(Arq,A);
      if (A.placa = Placa) then begin
         Posicao := FilePos(Arq) - 1;
      end;
   until (EOF(Arq)) or (Posicao <> -1) ;
   BuscaArquivo1 := Posicao;
end;

end.

BuscaPlacas.rar