obfuscator3

program project1;

uses
    SysUtils;

type
    wsk = ^elem;

    elem = record
    zawartosc: string;
    nast: wsk;
    end;

    tokeny = record
        zmienne: wsk;
        funkcje: wsk;
        procedury: wsk;
    end;

function Ostatni(glowa:wsk) : wsk;        //znajduje ostatni element listy
var
    aktualny:wsk;
begin
    aktualny := glowa;

    // Ostatni element ma wartosc nil, tego szukamy wsk warunku petli.
    while aktualny^.nast <> nil do
    begin
       aktualny := aktualny^.nast;
    end;

     Ostatni := aktualny;
end;

procedure Wstaw(glowa:wsk; wartosc:string);              //wstawia element do listy
var
    ostatni_element : wsk;
begin
    // Jeżeli pierwszy element jest pusty, podmień pierwszy
    // wsk przeciwnym wypadku znajdĹş ostatni i dodaj nowy element.
    if glowa^.zawartosc = '' then
    begin
        glowa^.zawartosc := wartosc;
        Exit;
    end;

    ostatni_element := Ostatni(glowa);

    ostatni_element^.nast := new(wsk);
    ostatni_element := ostatni_element^.nast;

    ostatni_element^.zawartosc := wartosc;
end;


procedure Dolacz(glowa, ogon:wsk);                 //laczy dwie listy ze soba
var
    ostatni_element:wsk;
begin
    // Jezeli pierwszy element jest pusty, podmienia pierwszy
    // wsk przeciwnym wypadku znajduje ostatni i dolacz ogon.
    if glowa^.zawartosc = '' then
    begin
        glowa^.nast := ogon^.nast;
        glowa^.zawartosc := ogon^.zawartosc;
        Exit;
    end;

    ostatni_element := Ostatni(glowa);

    ostatni_element^.nast := ogon;
end;

function WczytajPlik(nazwa:string) : wsk;                 //tworzy listę
var
    glowa, biez, kon: wsk;
    plik: text;
    linia: string;
begin
    assign(plik, nazwa);
    reset(plik);

    glowa := nil;
    biez := nil;
    kon := nil;

    while not Eof(plik) do
    begin
        readln(plik, linia);
        new(biez);

        biez^.zawartosc := LowerCase(linia);

        if glowa = nil then
            glowa := biez
        else
            kon^.nast := biez;

        kon := biez;
    end;

    close(plik);

    WczytajPlik := glowa;
end;

procedure ZapiszPlik(nazwa:string; kod:wsk);                      //zapisuje zaciemniony kod w pliku
var
    zawartosc : string;
    plik : text;
begin
    while kod <> nil do
    begin
        if (Pos('type', kod^.zawartosc) > 0)
           or (Pos('var', kod^.zawartosc) > 0)
           or (Pos('record', kod^.zawartosc) > 0)
           or (Pos('begin', kod^.zawartosc) > 0)
           or (Pos('then', kod^.zawartosc) > 0)
           or (Pos('do', kod^.zawartosc) > 0 ) then
           kod^.zawartosc := Concat(kod^.zawartosc, ' ');
        zawartosc := Concat(zawartosc, kod^.zawartosc);
        kod := kod^.nast;
    end;

    assign(plik, nazwa);
    rewrite(plik);
    write(plik, zawartosc);
    close(plik);
end;

procedure WypiszPlik(kod:wsk);                        //wypisanie zawartosci pliku na ekran
var
    biez: wsk;
begin
    biez := kod;

    while biez <> nil do
        begin
        writeln(biez^.zawartosc);
        biez := biez^.nast;
    end;
end;

function RozlozPrzecinek(linia: string) : wsk;              //rozklada nazwy zmiennych wypisanych po przecinku do osobnych lini
var
    zmienne: wsk;
begin
        new(zmienne);

    while Pos(',', linia) > 0 do
    begin
        Wstaw(zmienne, Trim(Copy(linia, 1, Pos(',', linia) - 1)));     //wstawia do listy element z nazwą zmiennej, która znajduje się przed przecinkiem

        linia := Copy(linia, Pos(',', linia) + 1, 255);          //usuwa nazwię zmiennej znajdującej się przed przecinkiem

        if Pos(',', linia) = 0 then
        begin
             Wstaw(zmienne, Trim(linia)); //wstawia do listy ostatnią zmienną z lini
        end;
    end;

    RozlozPrzecinek := zmienne;
end;

function RozlozVar(sekcja: wsk) : wsk;                     //"wyciąga" nazwy zmiennych z sekcji var
var
    wynik: wsk;
begin
    new(wynik);

    while Pos(':', sekcja^.zawartosc) > 0 do
    begin
        if Pos(',', sekcja^.zawartosc) > 0 then
        begin
            Dolacz(wynik, RozlozPrzecinek(Copy(sekcja^.zawartosc, 1, Pos(':', sekcja^.zawartosc) - 1)));         //dolacza liste zmiennych z procedury rozlozprzecinek
        end
        else
        begin
            Wstaw(wynik, Trim(Copy(sekcja^.zawartosc, 1, Pos(':', sekcja^.zawartosc) - 1)));   //wstawia do listy nazwy zmiennych przed znakiem ":"
        end;

        sekcja := sekcja^.nast;
    end;

    if wynik^.zawartosc = '' then
        RozlozVar := nil
    else
        RozlozVar := wynik;
end;

procedure RozlozArgumenty(linia:string; kontener:tokeny);                                //rozklada argumenty
var
    argumenty : wsk;
    zmienna : string;
begin
    new(argumenty);

    while (Pos(';', linia) > 0) do
    begin
          zmienna := Copy(linia, 1, Pos(';', linia) - 1);           //wycina zawartosc lini az do srednika

          while Pos(',', zmienna) > 0 do
          begin
              Wstaw(argumenty, Trim(Copy(zmienna, 1, Pos(',', zmienna) - 1)));         //wstawia do listy argument, który stoi przed przecinkiem
              zmienna := Copy(zmienna, Pos(',', zmienna) + 1, 255);                   //usuwa nazwe zmiennych przed przecinkiem
          end;

          linia := Copy(linia, Pos(';', linia) + 1, 255);                              //usuwa zmienne znajdujące się przed znakiem ";"
          Wstaw(argumenty, Trim(Copy(zmienna, 1, Pos(':', zmienna) - 1)));             //rozdziela nazwę zmiennej i jej typ, i wstawia do listy
    end;

    Wstaw(argumenty, Trim(Copy(linia, 1, Pos(':', linia) - 1)));                      //wstawia do listy ostatni argument z lini

    Dolacz(kontener.zmienne, argumenty);
end;

procedure RozlozFunction(ciag:string; kontener:tokeny);                                 //rozklada funkcje
begin
    if Pos('(', ciag) > 0 then
    begin
        RozlozArgumenty(Copy(ciag, Pos('(', ciag) + 1, Pos(')', ciag) - 1 - Pos('(', ciag)), kontener);        //rozklada argumenty funkcji
        Wstaw(kontener.funkcje, Trim(Copy(ciag, 9, Pos('(', ciag) - 9)));                                       //wstawia do kontenera nazwy
    end
    else
        Wstaw(kontener.funkcje, Trim(Copy(ciag, 9, Pos(':', ciag) - 9)));                                  //wstwia do kontenera to co przed dwukropkiem kiedy funkcja nie posiada nawiasow
end;

procedure RozlozProcedure(ciag:string; kontener:tokeny);
begin
     if Pos('(', ciag) > 0 then
     begin
          RozlozArgumenty(Copy(ciag, Pos('(', ciag) + 1, Pos(')', ciag) - 1 - Pos('(', ciag)), kontener);        //rozklada procedure
          Wstaw(kontener.procedury, Trim(Copy(ciag, 10, Pos('(', ciag) - 10)));                                  //wstawia do kontenera nazwy
     end
     else
        Wstaw(kontener.procedury, Trim(Copy(ciag, 10, Pos(';', ciag) - 10)));                                   //wstwia do kontenera to co przed srednikiem kiedy procedura nie posiada nawiasow
end;

function Tokenizuj(kod:wsk) : tokeny;             //przygotowuje nazwy do zaciemniania
var
    kontener: tokeny;
begin
    new(kontener.zmienne);
    new(kontener.funkcje);
    new(kontener.procedury);

    while kod <> nil do
    begin
        if Pos('var', LowerCase(kod^.zawartosc)) > 0 then
        begin
            Dolacz(kontener.zmienne, RozlozVar(kod^.nast));
        end;

        if (Pos('function ', LowerCase(kod^.zawartosc)) > 0) and (Pos('=', LowerCase(kod^.zawartosc)) = 0) then
        begin
             RozlozFunction(kod^.zawartosc, kontener);
        end;

        if (Pos('procedure ', LowerCase(kod^.zawartosc)) > 0) and (Pos('=', LowerCase(kod^.zawartosc)) = 0) then
        begin
             RozlozProcedure(kod^.zawartosc, kontener);
        end;

        kod := kod^.nast;
    end;

    Tokenizuj := kontener;
end;

function GenerujNazwe : string;             //generuje nazwy do zaciemniania
var
    ciag, wynik:string;
begin
    ciag := 'abcdefghijklmnopqrstuvwxyz';
    wynik := '';

    repeat
        wynik := wynik + ciag[Random(Length(ciag)) + 1];
    until (Length(wynik) = 6);

    GenerujNazwe := wynik;
end;

procedure PodmienZmienna(kod : wsk; zmienne: wsk);           //podmienia nazwy zmiennych
var
    linia:wsk;
    nowa_nazwa:string;
begin
    linia := kod;

    while zmienne <> nil do
    begin
        nowa_nazwa := GenerujNazwe;

        while linia <> nil do
        begin
            if (Pos(zmienne^.zawartosc, linia^.zawartosc) > 0) and ((Pos(zmienne^.zawartosc, linia^.zawartosc) > Pos('(', linia^.zawartosc))) then
            begin
                linia^.zawartosc := StringReplace(linia^.zawartosc, zmienne^.zawartosc, nowa_nazwa, []);
            end;

            linia := linia^.nast;
        end;

        zmienne := zmienne^.nast;
        linia := kod;
    end;
end;

procedure PodmienProcedury(kod : wsk; procedury : wsk);          //podmienia nazwy w procedurach
var
   linia:wsk;
   nowa_nazwa:string;
begin
   linia := kod;

   while procedury <> nil do
   begin
     nowa_nazwa := GenerujNazwe;

     while linia <> nil do
     begin
         if(Pos(procedury^.zawartosc, linia^.zawartosc) > 0) then
         begin
             linia^.zawartosc := StringReplace(linia^.zawartosc, procedury^.zawartosc, nowa_nazwa, [rfReplaceAll]);
         end;

         linia := linia^.nast;
     end;

     procedury := procedury^.nast;
     linia := kod;
   end;
end;

procedure PodmienFunkcje(kod : wsk; funkcje : wsk);      //podmienia nazwy funkcji
begin
   PodmienProcedury(kod, funkcje);
end;

procedure ZjedzWciecia(kod : wsk);          //usuwa wcięcia w każdej lini kodu osobno
begin
   while kod <> nil do
   begin
     kod^.zawartosc := TrimLeft(kod^.zawartosc);
     kod := kod^.nast;
   end;
end;

function Obfuskuj(kod:wsk) : wsk;         //obfuskuje
var
    kontener: tokeny;
begin
    kontener := Tokenizuj(kod);

    PodmienZmienna(kod, kontener.zmienne);
    PodmienFunkcje(kod, kontener.funkcje);
    PodmienProcedury(kod, kontener.procedury);

    ZjedzWciecia(kod);
end;

procedure Powitanie;
begin
   writeln('Witaj w Obfuscatorze!');
   writeln('=====================');
   writeln;
   write('> Podaj nazwe pliku aby rozpoczac proces zaciemniania: ');
end;

procedure UruchomAplikacje;
var
    kod: wsk;
    plik:string;
begin
   Powitanie;
   readln(plik);

   kod := WczytajPlik(plik);

   if kod <> nil then
   begin
     writeln('> Plik zostal wczytanie pomyslnie, rozpoczynam zaciemnianie.');
     Obfuskuj(kod);
     writeln(Concat('> Proces zakonczony. Kod wynikowy zostal zrzucony do pliku ', 'OBFSC_', plik));
     ZapiszPlik(Concat('OBFSC_', plik), kod);
   end
   else
   begin
     writeln('> Plik nie istnieje badz jest nieosiagalny. Koncze dzialanie.');
   end;
end;

begin
    begin
        Randomize;
        UruchomAplikacje;

        readln;
    end;
end.