PROGRAM MULTI LIST MENGGUNAKAN TURBO PASCAL

buat file yang berisi biodata :

Buat file NIRM :

Koding program :

uses crt;
type
filebio = record
     npm:string[8];
     nirm:string[3];
     nama:string[15];
     alamat:string[10];
     end;
filenirm = record
     nirm2:string[3];
     masuk:string[10];
     akhir:string[10];
     end;
var
biodata :array[1..10] of filebio;
tglnirm :array[1..10] of filenirm;
isi:text;
a,x,y:integer;


Procedure tbio;
begin
a:=5;
assign(isi,'biodata.dat');
reset(isi);
writeln('Biodata');
writeln('************************************************************');
writeln('*    Npm     * Nirm  *         Nama        *     alamat    *');
writeln('************************************************************');
for x:=1 to 10 do
begin
readln(isi,biodata[x].npm);
readln(isi,biodata[x].nirm);
readln(isi,biodata[x].nama);
readln(isi,biodata[x].alamat);
write('*  ',biodata[x].npm,'  *  ',biodata[x].nirm,'  *   ',biodata[x].nama,'   *    ',biodata[x].alamat:5);
gotoxy(60,a);
writeln('*');
a:=a+1;
end;
close(isi);
writeln('************************************************************');
readln;
end;

procedure tnirm;
begin
assign(isi,'filenirm.dat');
reset(isi);
writeln('File Nirm');
writeln('*****************************************************');
writeln('* Nirm   *    Tanggal Masuk    *    Tanggal Akhir   *');
writeln('*****************************************************');
for x := 1 to 10 do
begin
readln(isi,tglnirm[x].nirm2);
readln(isi,tglnirm[x].masuk);
readln(isi,tglnirm[x].akhir);
writeln('*  ',tglnirm[x].nirm2,'   *     ',tglnirm[x].masuk,'      *     ',tglnirm[x].akhir,'     *');
end;
writeln('*****************************************************');
close(isi);
readln;
end;


procedure daftarsiswa;
begin
a:=5;
gotoxy(1,30);writeln('Daftar Siswa');
writeln('***********************************************************************');
writeln('* No *    Npm   * Nirm *       Nama       *  Tgl masuk  *  Tgl Akhir  *');
writeln('***********************************************************************');
for x := 1 to 10 do
begin
write('* ',x,'  * ',biodata[x].npm,' * ',biodata[x].nirm,'  * ',biodata[x].nama,'            *','             *','       ');
for y := 1 to 10 do
if biodata[x].nirm = tglnirm[y].nirm2 then
begin
gotoxy(46,a);
writeln(tglnirm[y].masuk);
gotoxy(60,a);
writeln(tglnirm[y].akhir);
a:=a+1;
end;
end;
writeln('***********************************************************************');
readln;
end;

begin
clrscr;tbio;
clrscr;tnirm;
clrscr;daftarsiswa;
end.

Hasil program multi list :

Program File Sequensial

IDENTIFICATION DIVISION .
PROGRAM – ID. SEQUEL .
AUTHOR . JOGIYANTO HM .
SECURITY . PROGRAM MEMASUKAN DATA ORGANISASI FILE SEQUENTIAL
ENVIRONMENT DIVISION .

INPUT – OUTPUT SECTION .

FILE – CONTROL.

SELECT PENJUALAN ASSIGN TO DISK.

ORGANIZATION IS SEQUENTIAL.

ACCESS MODE IS SEQUENTIAL.

FILE STATUS IS STATUS – SALAH .

DATA DIVISION .

FILE SECTION .

FD PENJUALAN.

LABEL RECORD IS STANDARD.

VALUE OF FILE – ID IS ‘ JUAL . DAT ‘

DATA RECORD IS RECORD – RELASI .

01 DATA – PENJUALAN .

02 NOMER – FAKTUR PIC X ( 12 ) .

02 NAMA – LANGGANAN PIC X ( 25 ) .

02 KODE – JUAL PIC A .

88 TUNAI VALUE IS ‘ T ‘ .

88 KREDIT VALUE IS ‘ K ‘ .

02 NILAI – JUAL PIC 9 ( 6 ) .

WORKING – STORAGE SECTION .

77 STATUS – SALAH PIC XX .

01 SUDAH – BENAR PIC X .

88 BENAR VALUE ‘ Y ‘ , ‘ y ‘ .

88 BELUM VALUE ‘ T ‘ , ‘ t ‘ .

01 MASUKKAN – LAGI – TIDAK PIC X .

88 LAGI VALUE ‘ Y ‘ , ‘ y ‘ .

88 TIDAK VALUE ‘ T ‘ , ‘ t ‘ .

SCREEN SECTION .

01 HAPUS LAYAR .

02 BLANK SCREEN .

01 LAYAR – DATA .

02 LINE 4 COLUMN 5 ‘ NOMER FAKTUR

02 COLUMN PLUS 1 PIC X ( 12 ) TO NOMER – FAKTUR  REQUIRED .

02 LINE 6 COLUMN 5 ‘ NAMA LANGGANAN .

02 COLUMN PLUS 1 PIC X ( 25 ) TO NAMA – LANGGANAN .

02 LINE 8 COLUMN 5 ‘ KODE TRANSAKSI

02 COLUMN PLUS 1 PIC A TO KODE – JUAL .

02 LINE 10 COLUMN 5 ‘ NILAI PENJUALAN .

02 COLUMN PLUS 1 PIC 9 ( 6 ) TO NILAI – JUAL .

PROCEDURE DIVISION .
RUTIN – UTAMA SECTION .
BUKA – FILE .
OPEN OUTPUT PENJUALAN .
MULAI .
MOVE SPACE TO SUDAH – BENAR
PERFORM MASUKKAN – DATA UNTIL BENAR
PERFORM REKAM – DATA
PERFORM ADA – LAGI – TIDAK .
SELEKSI – MASUKKAN – LAGI – TIDAK .
IF LAGI
GO TO MULAI .
SELESAI .
CLOSE PENJUALAN
STOP RUN .
RUTIN – BAGIAN SECTION .
MASUKKAN – DATA .
DISPLAY HAPUS – LAYAR
DISPLAY LAYAR – DATA
ACCEPT LAYAR – DATA .
DISPLAY ( 18 , 5 ) ‘ SUDAH BENAR ( Y / T ) ? ‘
ACCEPT ( , ) SUDAH – BENAR .
REKAM – DATA .
MOVE ‘ ‘ TO STATUS – SALAH.
WRITE DATA – PENJUALAN.
PERFORM SELEKSI – REKAMAN .
ADA – LAGI – TIDAK .
DISPLAY ( 10 , 5 ) ‘ ADA LAGI DATA LAINNYA ( Y / T ) ? ‘.
ACCEPT ( , ) MASUKKAN – LAGI – TIDAK .
SELEKSI – REKAMAN .
IF STATUS – SALAH = ‘ 34 ‘.
DISPLAY ( 18 , 5 ) ‘ TIDAK TEREKAM , DISK PENUH ‘ .
IF STATUS – SALAH = ‘ 91 ‘.
DISPLAY ( 18 , 5 ) ‘ STRUKTUR FILE RUSAK ‘ .

Flowchart Update Data Sequential

 

LOGIKA

1.      Proses pertama adalah menunggu input data dari keyboard input ini berupa data yang akan disisipkan ke dalam file. Variable yang dipakai sebagai input adalah :

NMS : variable nama

NPMS : variable npm

KLS : variable kelas

2.      Baca record dari file01. Variable yang digunakan untuk menampung data dari file ini adalah :

NM : variable nama

NPM  : variable npm

KL  : variable kelas

3.      Periksa isi recoard, jika isinya sama dengan /* maka proses berakhir

4.       Pindahkan record dari file01 yang tersimpan didalam variable NM, NMP,KL ke variable penampung untuk file02. Variable penampung tersebut adalah:

 NMO : variable nama

 NPMO  : variable npm

 KLO: variable kelas

5.      pindahkan data di variable penampung ke dalam file file02

6.       periksa isi variable NM, jika isi NM tidak sama dengan ‘ASTRI’; maka proses kembali ke langka 2 untuk membaca record selanjutnya.

7.       pindahkan data yang akan disisipkan ke variable penampung untuk file02. Data yang akan disisipkan ini tersimpan didalam variable NMS, NPMS, KLS.

8.      pindahkan data didalam variable penampung ke dalam file file01

9.      kembali ke langkah 2 untuk membaca data berikutnya

program sortir data

Program sortir ini di buat menggunakan turbo pascal.

Ketikan koding yang ada dibawah ini :

program sortir_2db01;
uses crt;
label awal;
var
oke:char;
type
tipelarik=string[25];
larikurut=array[1..100] of tipelarik;

procedure masukkan;
label akhir;
const b='            ';
type mhs= record
npm:string[8];kelas:string[5];nm:string[12];
end;
var vfilemhs:file of mhs;
recmhs:mhs; i:integer; oke:char;
begin
clrscr;
assign(vfilemhs,'dataimam.TXT');
{$i-}reset(vfilemhs);{$i+}
if ioresult <> 0 then rewrite (vfilemhs);
i:=filesize(vfilemhs);
with recmhs do
begin
write('npm :');readln(npm);
while (npm <>'') and (length(npm)=8)do
begin
write ('kelas :');readln(kelas);
if length(kelas)<5 then
goto akhir;
write('nama :');readln(nm);
 if length(nm) <12 then
nm:=concat(nm,b);
repeat
write('save file ... y/n?');readln(oke);
until oke in ['Y','y','n','N'];
if oke in ['y','Y'] then
 begin
seek(vfilemhs,i);write(vfilemhs,recmhs);inc(i);
end;
akhir
:writeln;
write('npm:');readln(npm);
end;
writeln('data yang anda masukin salah');
end;
close(vfilemhs);readln;
end;

    procedure quicksort(var x:larikurut;  bawah,atas:word);
    var i,j:word;
    sementara:tipelarik;
    begin
    while atas>bawah do
    begin
    i:=bawah;
    j:=atas;
    sementara:=x[bawah];
    while i<j do
    begin
        WHILE x[J]>sementara Do
             J:=J-1;
         x[i]:=x[j];
             while(i<j) and (x[i]<=sementara) do
             i:=i+1;
         x[j]:=x[i];
         end;
         x[i]:=sementara;
        quicksort(x,bawah,i-1);
        bawah:=i+1;
        end;
        end;


PROCEDURE GARIS;
BEGIN
 writeln('----------------------------------------');
END;
procedure kelompok;
begin
clrscr;
GOTOXY(28,4);
GARIS;
GOTOXY(27,5);WRITE('|');  GOTOXY(68,5);WRITE('|');
GOTOXY(27,6);WRITE('|');  GOTOXY(68,6);WRITE('|');
gotoxy(35,6);writeln('<<<KELOMPOK  PEMROGRAMAN >>>'); GOTOXY(68,7);WRITE('|');
GOTOXY(27,7);WRITE('|'); GOTOXY(68,7);WRITE('|');
GOTOXY(47,7);WRITELN('2DB01');GOTOXY(68,8);WRITE('|');
GOTOXY(27,8);WRITE('|');GOTOXY(68,9);WRITE('|');
GOTOXY(27,9);WRITE('|'); GOTOXY(68,10);WRITE('|');
GOTOXY(28,9);GARIS;
GOTOXY(27,10);WRITE('|');
gotoxy(29,10);WRITELN('1. ASTRI');
GOTOXY(27,11);WRITE('|'); GOTOXY(68,11);WRITE('|');
gotoxy(29,11);WRITELN('2. DWI');
GOTOXY(27,12);WRITE('|');GOTOXY(68,12);WRITE('|');
gotoxy(29,12);WRITELN('3. IMAM');
GOTOXY(27,13);WRITE('|');GOTOXY(68,13);WRITE('|');
gotoxy(29,13);WRITELN('4. MAYA');
GOTOXY(27,14);WRITE('|');GOTOXY(68,14);WRITE('|');
gotoxy(29,14);WRITELN('5. MILA');
GOTOXY(28,15);
GARIS;
END;
procedure tampilan(var x:char);
type
mhs=record
npm:string[8];
kelas:string[5];
nm:string[12];
end;label awal,akhir,empat;
var
gabung,gabung1,name,npms,class:larikurut;
vfilemhs: file of mhs;
recmhs:mhs;
i,J:integer;temp:STRING[5];
COBA:CHAR;
begin
awal:
clrscr;
assign(vfilemhs,'dataimam.txt');
reset(vfilemhs);
for i:= 1 to filesize(vfilemhs) do
begin
seek(vfilemhs,i-1);
read(vfilemhs,recmhs);
name[i]:=recmhs.nm;
class[i]:=recmhs.kelas;
npms[i]:=recmhs.npm;
gabung[i]:=concat(name[i],npms[i],class[i]);
gabung1[i]:=concat(class[i],name[i],npms[i]);
end;
J:=2;
if x='2' then
quicksort(gabung,1,filesize(vfilemhs));
if x='3' then
quicksort(gabung1,1,filesize(vfilemhs));
if x='4' then
begin
              quicksort(gabung1,1,filesize(vfilemhs));
              write('kelas :');readln(temp);
              IF LENGTH(TEMP)<>5 THEN
              BEGIN
              clrscr; gotoxy(28,10);repeat writeln('SEARCH KELAS TIDAH DI TEMUKAN <ULANGI(y/n)!!>');readln(coba);
              until COBA in ['Y','y','n','N'];
              if COBA in ['y','Y'] then
              goto AWAL else goto akhir;
              end;

              clrscr;
             gotoxy(30,2);writeln('KELAS :',temp);
             gotoxy(29,3);writeln('DAFTAR MAHASISWA');
             goto empat;
             end;

clrscr;
empat:
GOTOXY (23,4);
GARIS;
GOTOXY (23,6);
writeln('|no  npm        kelas    nama        |');
GOTOXY (23,8);
GARIS;
writeln;
for i:=1 to filesize(vfilemhs)  do
begin
if (name[i]<>'') then  begin
if x='1' then  BEGIN
GOTOXY (23,I+9);writeln('|',i:2,'| ',copy(gabung[i],13,8),'   ',copy(gabung[i],21,5) ,'    ',copy(gabung[i],0,12),'|'); END;
if x='2' then  BEGIN
GOTOXY (23,I+9);writeln('|',i:2,'| ',copy(gabung[i],13,8),'   ',copy(gabung[i],21,5) ,'    ',copy(gabung[i],0,12));   END;
if x='3' then  BEGIN
GOTOXY (23,I+9);writeln('|',i:2,'| ',copy(gabung1[i],18,8),'   ',copy(gabung1[i],0, 5) ,'    ',copy(gabung1[i],6,12));END;
if (x='4') and (copy(gabung1[i],1,5)=temp) then  BEGIN
GOTOXY (23,I+9);writeln('|',i:2,'| ',copy(gabung1[i],18,8),'   ',copy(gabung1[i],0, 5) ,'    ',copy(gabung1[i],6,12));END;
end;
J:=I+10;
end;
GOTOXY(23,J);GARIS;
akhir:
end;
var
m:char;
begin
awal:
clrscr;
GOTOXY (28,3);WRITELN('<<< MENU FILE >>>');
GOTOXY (28,5);writeln('1 INPUT DATA');
GOTOXY (28,6);writeln('2 DATA ACAK');
GOTOXY (28,7);writeln('3 SORTIR NAMA');
GOTOXY (28,8);writeln('4 SORTIR KELAS');
GOTOXY (28,9);writeln('5 MENAMPILKAN KELAS');
GOTOXY(28,10);WRITELN('6 SELESAI');
GOTOXY (28,12);write('PILIHAN ?');readln(oke);
IF NOT (OKE IN ['1'..'6']) THEN
BEGIN
WRITELN(CHAR(7));
GOTOXY (28,13);WRITELN('PILIHAN SALAH !!!');
READLN;
GOTO awal;
END;
case oke of
'1':begin masukkan;goto awal; end;
'2':BEGIN m:='1';tampilan(m);readln;goto awal; end;
'3':begin m:='2';tampilan(m);readln;goto awal; end;
'4':begin m:='3';tampilan(m);readln;goto awal; end;
'5':begin m:='4' ;tampilan(m); readln;goto awal; end;
'6':begin kelompok; end;
end;
readln;
end.

Setelah itu compile program dengan alt+f9 , lalu run program dengan ctrl+f9. Setelah di run akan muncul hasil seperti di bawah ini :

Muncul menu file , pilih nomor 1 untuk menginput data yang akan di sortir, seperti dibawah ini :

 
Pilih nomor 2 untuk melihat data acak yang telah diinput :

 

Untuk sortir data menurut nama pilih nomor 3 , seperti dibawah ini :

Untuk sortir data menurut kelas pilih nomor 4 , seperti dibawah ini :

 

 

 

Untuk menampilkan kelas yang diinginkan pilih nomor 5 dan masukkan kelas
yang ingin dilihat datanya :

Pilih nomor 6 untuk melihat tampilan nama anggota kelompok pembuat 

program sortir 2DB01, seperti dibawah ini :