uses dvcrt, dvwin;
var arq, arqsai: text;
    s, dirDest, nomeOrig: string;
    primeira, lidos, geradas: integer;
    quantas, serial: integer;

{--------------------------------------------------------}
{            remove acentos de uma cadeia
{--------------------------------------------------------}

function semAcentos (s: string): string;
const
    tabMaiuscPC: array [#$80..#$ff] of char = (

    'C','U','E','A','A','A','A','C','E','E','E','I','I','I','A','A',
    'E','þ','þ','O','O','O','U','U','Y','O','U','þ','þ','þ','þ','þ',
    'A','I','O','U','N','N','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ',
    'þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ','þ',
    'A','A','A','A','A','A','‘','C','E','E','E','E','I','I','I','I',
    'þ','N','O','O','O','O','O','X','þ','U','U','U','U','Y','þ','þ',
    'A','A','A','A','A','A','‘','C','E','E','E','E','I','I','I','I',
    'þ','N','O','O','O','O','O','X','þ','U','U','U','U','Y','þ','þ');

var
    s2: string;
    i: integer;

begin
    move (s, s2, length(s)+1);
    for i := 1 to length (s2) do
        if s2[i] in ['a'..'z'] then
            s2[i] := upcase (s2[i])
        else
        if s2[i] >= #$80 then
            s2[i] := tabMaiuscPC [s2[i]];

    semAcentos := s2;
end;

{--------------------------------------------------------}
{                 gera nome do arquivo
{--------------------------------------------------------}

function geraNomeArqNovo (semente, extensao: string): string;
var nome, s: string;
    arq: file;
    p, i, valor: integer;
    achou: boolean;
begin
    repeat
        p := pos (' ', semente);
        if p <> 0 then delete (semente, p, 1);
    until p = 0;
    repeat
        p := pos ('''', semente);
        if p <> 0 then delete (semente, p, 1);
    until p = 0;
    repeat
        p := pos ('.', semente);
        if p <> 0 then delete (semente, p, 1);
    until p = 0;
    repeat
        p := pos (',', semente);
        if p <> 0 then delete (semente, p, 1);
    until p = 0;
    semente := semAcentos (copy (semente, 1, 3));

    achou := false;
    repeat
        valor := serial;
        serial := serial + 1;

        str (valor, s);
        while length (s) < 5 do
            s := '0' + s;

        nome := s+semente;
        assign (arq, nome + '.' + extensao);
        writeln (nome);
        {$I-}  reset (arq);  {$I+}
        achou := ioresult = 0;
        if achou then close (arq);
    until not achou;

    geraNomeArqNovo := nome + '.' + extensao;
end;

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

procedure geraArquivo (s: string);
var
    Nome, Telefone, Cidade, Endereco, Bairro, CEP: string;

begin
    Nome := trim (copy (s, 3, 41));
    Telefone := trim (copy (s, 44, 16));
    Cidade := trim (copy (s, 60, 16));
    Endereco := trim (copy (s, 76, 26));
    Bairro := trim (copy (s, 102, 16));
    CEP := trim (copy (s, 118, 9));

    if Telefone <> '' then
        begin
            assign (arqsai, dirDest+ '\' + geraNomeArqNovo (nome, 'FIC'));
            rewrite (arqSai);

            writeln (arqSai, '[Dados de contato]');
            writeln (arqSai, 'Nome=', Nome);
            writeln (arqSai, 'Telefone=', Telefone);

            writeln (arqSai, '[Dados pessoais]');
            writeln (arqSai, 'Empresa=', nome);
            writeln (arqSai, 'Endereço=', endereco);
            writeln (arqSai, 'Cidade=', cidade);
            writeln (arqSai, 'CEP=', cep);

            close (arqSai);
        end
    else
        geradas := geradas - 1;
end;

begin
    sintinic (2, '');
    sintWriteln ('Conversor de fichas');
    writeln;
    sintWriteln ('Número da primeira ficha');
    sintReadint (primeira);
    sintWriteln ('Quantas fichas ? ');
    sintReadint (quantas);
    sintWriteln ('Serial da primeira ficha');
    sintReadint (serial);
    sintWriteln ('Qual o diretório de destino');
    sintReadln (dirDest);
    {$I-} mkdir (dirDest);  {$I+}
    if ioresult = 0 then
        sintWriteln ('Diretório foi criado')
    else
        sintWriteln ('Atenção!  Vou usar diretório já existente');
    sintWriteln ('Qual o arquivo original');
    sintReadln (nomeorig);

    geradas := 0;
    lidos := 0;

    assign (arq, nomeorig);
    reset (arq);
    readln (arq, s);    { ignora titulo }
    while not eof (arq) and (geradas < quantas) do
        begin
            readln (arq, s);
            if s <> '' then
                begin
                    lidos := lidos + 1;
                    if lidos >= primeira then
                        begin
                            geraArquivo (s);
                            geradas := geradas + 1;
                        end;
                end;
        end;
    close (arq);
    sintWriteln ('ok');
    sintFim;
    doneWinCrt;
end.
