binnery tree


program konversi;
uses crt;
var i, j, nilai,  code: integer;
    kalimat, kodebiner, subtext, hasil, m, temp, cbaru, bit8 : string;
    lagi : char;
{**Prosedur mengkonversi bilangan desimal ke biner 8 bit**}
function dec2biner8bit(var angka : integer):string;
var bytestr, buf : string;
begin
  bytestr := '';
  repeat
    str(angka mod 2,buf);
    bytestr := buf + bytestr;
    angka := angka div 2;
  until(angka = 0);
  {**Jika panjang bytestr bukan kelipatan 8,**}
  {**maka panjangnya jadikan kelipatan 8**}
  while(length(bytestr) mod 8 <> 0) do bytestr := '0'+bytestr;
  dec2biner8bit := bytestr;
end;


{**Prosedur mengubah kode ASCII  ke bilangan biner**}
function ascii2biner(var kata : string):string ;
var hasil : string;
    kodeascii, i : integer;
begin
  hasil := '';
  for i := 1 to length(kata) do
  begin
    kodeascii := ord(kata[i]);
    hasil := hasil + dec2biner8bit(kodeascii);
  end;
  ascii2biner := hasil;
end;

function dec2biner3bit(var angka : integer):string;
var bytestr, buf : string;
begin
  bytestr := '';
  repeat
    str(angka mod 2,buf);
    bytestr := buf + bytestr;
    angka := angka div 2;
  until(angka = 0);
  while(length(bytestr) mod 3 <>0) do bytestr := '0'+bytestr;
  dec2biner3bit:= bytestr;
end;


{**Prosedur menghitung pangkat suatu bilangan**}
function pangkatbyte(x : integer; n : integer):integer;
var i, hasil : integer;
begin
  hasil := 1;
  for i := 1 to n do
    hasil := hasil*x;
  pangkatbyte := hasil;
end;


{**Prosedur mengubah bilangan biner ke bilangan desimal**}
function biner2dec(var kata : string):integer;
var ntemp, i, code : integer;
    hasil : integer;
begin
  hasil := 0;
  for i := 1 to length(kata) do
  begin
    val(kata[i],ntemp,code);
    if code <> 0 then write('Kesalahan pada posisi ',code)
    else
    begin
      if(ntemp > 1) then write('Ada kesalahan format bilangan ')
      else
        hasil := hasil + ntemp * pangkatbyte(2,length(kata)-i);
    end;
  end;
  biner2dec := hasil;
end;


begin
  lagi := 'Y';
  while (upcase(lagi)='Y')do
  begin
    clrscr;
    write('Masukkan kalimat : '); readln(kalimat);

    {Proses Enkripsi}

    {ubah kode ascii ke format biner}
    kodebiner := ascii2biner(kalimat);

    {ubah dari kode biner ke bentuk biner 3 bit dan geser 2}
    i := 1; hasil :='';
    while(i <=length(kodebiner)) do
    begin
      subtext := copy(kodebiner,i,3);
      if (length(subtext) < 3) then temp:= subtext
      else
      begin
        str((biner2dec(subtext) + 2) mod 8,m);
        val(m,nilai,code);
        temp := dec2biner3bit(nilai);
      end;
      hasil := hasil+temp;
      i := i+3;
    end;

    {ubah ke karakter baru}
    j:=1; cbaru :='';
    while(j < length(hasil)) do
    begin
      bit8 := copy(hasil,j,8);
      cbaru := cbaru + char(biner2dec(bit8));
      j := j+8;
    end;
    write('Karakter Hasil Enkripsi : ',cbaru);
    writeln;


    {Proses Dekripsi}

    {ubah kode ascii ke format biner}
    kodebiner := ascii2biner(cbaru);

    {ubah dari kode biner ke bentuk biner 3 bit dan geser 2}
    i := 1; hasil:='';
    while(i <=length(kodebiner)) do
    begin
      subtext := copy(kodebiner,i,3);
      if (length(subtext) < 3) then temp:= subtext
      else
      begin
        str((biner2dec(subtext)+ 8 - 2 ) mod 8,m);
        val(m,nilai,code);
        temp := dec2biner3bit(nilai);
      end;
      hasil := hasil+temp;
      i := i+3;
    end;

    {ubah ke karakter baru}
    j:=1;cbaru := '';
    while(j < length(hasil)) do
    begin
      bit8 := copy(hasil,j,8);
      cbaru := cbaru + char(biner2dec(bit8));
      j := j+8;
    end;
    writeln('Karakter Hasil Dekripsi : ',cbaru);
    write('Lagi : '); lagi := readkey;
  end;
end.

Komentar

Posting Komentar

Postingan populer dari blog ini

algoritma dan pascal

Algoritma adalah suatu urutan langkah-langkah (steps) yang disusun secara logis untuk menyelesaikan masalah dengan menggunakan komputer, dengan kreteria sebagai berikut : Setiap langkah / steps harus jelas dan pasti (definite) Diperbolehkan tanpa ada output tetapi minimal harus ada satu output. Jumlah langkah harus berhingga atau dengan kata lain harus ada stopping criteria. Penyajian Algoritma dapat disajikan dalam dua cara yaitu : (1). Secara gambar (FlowChart) dan (2) Secara Tulisan (Struktur bahasa dan Pseudo Code). disini yang  akan kita bahas adalah penyajian Algoritma secara tulisan dengan Pseudo Code Pascal. B. Algoritma dengan Pseudo Code Pascal Dalam bahasa pascal kurang lebih ada 11 statement, namun mengingat waktu yang terbatas pada kesempatan kali ini kita hanya membahas 1 sub pokok bahasan yaitu tentang struktur perulangan dalam pascal. 1. Sturktur perulangan dalam Pascal Dalam Pascal kurang lebih ada tiga struktur perulangan, yaitu : a. While-...
Baca selengkapnya

CERITA

di malam ini dibawah langit ini aq buat sebuah cerita aq buat sebuah wacana yang terisi banyak nya kata kata  yang di buat dari tetesan air mata yang terungkap tatanan kasih asmara yang hiasi indahnya purnama walau tanpa tahu apa akhirnya walau begitu, tangan ini tak mau berhenti hati ini tak mau bergetar rasa ini semakin menndalam  dan q thu tiada cerita yang buat q harus tahu keadaan ini
Baca selengkapnya

cara enkripsi dengan chiper

Enkrip kalimat berikut “Saya Senang belajar keamanan aplikasi dan data” Metode : super-enkripsi dengan kata kunci nama panggilan anda (*masing-masing) serta dengan K transposisi = jumlah huruf nama panggilan anda. Jawab Tabel Subtitusi A B C D E F G H I J K L M N O P Q R S T U V W X Y Z A R I F B C D E G H J K L M N O P Q S T U V W X Y Z Plain Text S A Y A S E N A N G B E L A J A R K E A M A N A N A P L I K A S I D A N D A T A Chiper Text S A Y A S B M A M D R B K A H A Q J B A L A M A M A O K G J A S G F A M F A T A Chiper Transposisi - K Transposisi = 4 - Text : SAYASBMAMDRBKAHAQJBALAMAMAOKGJASGFAMFATA S A Y A S B M A M D R B K A H A Q J B A L A M A M A O K G J A S G F A M F A T A - Chiper text baru : SSMKQLMGGFABDAJAAJFAYMRHBMOAATAABAAKSMA
Baca selengkapnya