Skip to content

Instantly share code, notes, and snippets.

@botic

botic/hash.cbl

Created October 30, 2011 21:55
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save botic/1326503 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save botic/1326503 to your computer and use it in GitHub Desktop.
Download ZIP
COBOL Code aus der guten alten HTL-Zeit.
Raw
hash.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. HASH.
AUTHOR. Philipp Nderer.
DATE-WRITTEN. 02-11-26.
DATE-COMPILED.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT HASHREL ASSIGN TO "HASHREL.DAT"
ORGANIZATION IS RELATIVE
ACCESS MODE IS RANDOM
RELATIVE KEY IS HASHKEY
FILE STATUS IS W-IOSTAT.
SELECT HASHOVERFLOW ASSIGN TO "HASHOVERFLOW.DAT"
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS W-IOSTAT.
DATA DIVISION.
FILE SECTION.
FD HASHREL.
01 HASHSATZ.
02 HARTNR PIC 999.
02 HNAME PIC X(15).
FD HASHOVERFLOW.
01 HOSATZ.
02 HOARTNR PIC 999.
02 HONAME PIC X(15).
WORKING-STORAGE SECTION.
01 HHELP.
02 HHARTNR PIC 999.
02 HHNAME PIC X(15).
01 W-IOSTAT.
02 W-IOSTAT1 PIC X.
02 W-IOSTAT2 PIC X.
01 ARTNUMMER PIC 999.
01 ARTNAME PIC X(15).
01 CONTR PIC 9 VALUE 1.
01 HASHKEY PIC 999.
01 HELPKEY PIC 99999.
PROCEDURE DIVISION.
INIT.
OPEN I-O HASHREL.
OPEN OUTPUT HASHOVERFLOW.
DATEI-BESCHREIBEN.
PERFORM UNTIL CONTR = 0
DISPLAY "NUMMER >> "
ACCEPT ARTNUMMER
DISPLAY SPACES
DISPLAY "NAME >> "
ACCEPT ARTNAME
DISPLAY SPACES
DISPLAY "Weiter? (1..JA / 0..NEIN)"
* Variable dient zum Ermitteln, ob der Benutzer fortfahren will
ACCEPT CONTR
DISPLAY SPACES
* Ermitten des verhashten Schuessels indem man einfach den
* Rest einer Division als Schluessel verwendet.
DIVIDE 999 INTO ARTNUMMER
GIVING HELPKEY
REMAINDER HASHKEY
ON SIZE ERROR PERFORM BEENDEN
END-DIVIDE
* Speichern der eingegebenen Daten in die Felder der Dateien
MOVE ARTNUMMER TO HARTNR
MOVE ARTNAME TO HNAME
MOVE ARTNUMMER TO HOARTNR
MOVE ARTNAME TO HONAME
* Man versucht an der durch das Hashverfahren ermittelten
* Stelle einen Lesevorgang durchzufuehren. Falls dieser
* misslingt, wird in die relative Datei geschrieben.
* Bei Erfolg in die sequentielle Datei, da der Platz
* bereits belegt ist.
READ HASHREL RECORD INTO HHELP
INVALID KEY WRITE HASHSATZ END-WRITE
NOT INVALID KEY WRITE HOSATZ END-WRITE
END-READ
END-PERFORM.
BEENDEN.
CLOSE HASHREL.
CLOSE HASHOVERFLOW.
STOP RUN.
Raw
rechner.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID.
RECHEN.
AUTHOR.
PHILIPP NADERER.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ZAHLA PIC S9(5)V99.
01 ZAHLB PIC S9(5)V99.
01 ERGEB PIC -(10)9.99.
01 RECHE PIC X.
PROCEDURE DIVISION.
EINGEBEN.
***********************************************************************
* Die Operatoren und das Rechenzeichen werden eingelesen. *
***********************************************************************
DISPLAY ".: Einfacher Rechner :.".
DISPLAY SPACES.
DISPLAY "OP1 ->".
ACCEPT ZAHLA.
DISPLAY SPACES.
DISPLAY "RZ ->".
ACCEPT RECHE.
DISPLAY SPACES.
DISPLAY "OP2 ->".
ACCEPT ZAHLB.
DISPLAY SPACES.
DISPLAY SPACES.
BERECHNE.
***********************************************************************
* Die Fallunterscheidung, wo entschieden wird, welche Rechenoperation *
* ausgeführt werden soll. Eine fehlerhafte Eingabe wird durch den *
* letzten ELSE-Zweig abgefangen. *
***********************************************************************
IF RECHE = "+" THEN
ADD ZAHLA TO ZAHLB GIVING ERGEB
ELSE
IF RECHE = "-" THEN
SUBTRACT ZAHLB FROM ZAHLA GIVING ERGEB
ELSE
IF RECHE = "*" THEN
MULTIPLY ZAHLA BY ZAHLB GIVING ERGEB
ELSE
IF RECHE = "/" THEN
DIVIDE ZAHLB INTO ZAHLA GIVING ERGEB
ELSE
DISPLAY "FEHLERHAFTE EINGABE"
END-IF.
AUSGABE.
***********************************************************************
* Ausgabe des Ergebnisses *
***********************************************************************
DISPLAY ERGEB.
DISPLAY SPACES.
STOP RUN.
Raw
schuelerlist.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST06.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT KLASSE ASSIGN TO DISK "KLASSE.DAT".
DATA DIVISION.
FILE SECTION.
FD KLASSE.
01 NAME PIC X(30).
WORKING-STORAGE SECTION.
01 NAME-EA PIC X(30).
01 HILFSV PIC 99 BINARY.
01 QUIT-EA PIC Z(10)9.
01 QUIT PIC 99 BINARY.
PROCEDURE DIVISION.
EINGABE.
OPEN OUTPUT KLASSE
COMPUTE HILFSV = 0
PERFORM UNTIL HILFSV > 50
DISPLAY "Name -> "
ACCEPT NAME-EA
WRITE NAME FROM NAME-EA
DISPLAY "BEENDEN (0 .. Ja / 1 .. Nein)"
ACCEPT QUIT-EA
MOVE QUIT-EA TO QUIT
IF QUIT = 0 THEN
COMPUTE HILFSV = 51
END-IF
COMPUTE HILFSV = HILFSV + 1
END-PERFORM.
BEENDE.
CLOSE KLASSE
STOP RUN.
Raw
wareneingabe.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. DATEI1.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT WAREN-DATEI ASSIGN TO "WAREN.XXX"
ACCESS IS SEQUENTIAL
* ORGANIZATION RELATIVE
* RELATIVE KEY W-NUMMER
FILE STATUS W-IOSTAT.
DATA DIVISION.
FILE SECTION.
FD WAREN-DATEI.
01 W-SATZ.
02 W-NAME PIC X(20).
02 W-ART PIC X(3).
02 W-BESTAND PIC 9(6).
02 W-PREISE PIC S9(5)V99 OCCURS 5.
WORKING-STORAGE SECTION.
01 W-NUMMER PIC 9(5).
01 W-IOSTAT.
02 W-IOSTAT-1 PIC X.
02 W-IOSTAT-2 PIC X.
01 EINGABE-FELD.
02 NUMMER PIC 9(5).
02 AENDER PIC 9.
02 SATZ.
03 NAME PIC X(20).
03 ART PIC X(3).
03 BESTAND PIC 9(6).
03 PREISE PIC S9(5)V99 OCCURS 5.
PROCEDURE DIVISION.
DATEI-OEFFNEN.
OPEN OUTPUT WAREN-DATEI.
IF W-IOSTAT NOT = "00"
THEN DISPLAY "OPEN-Fehler: " W-IOSTAT
STOP RUN.
DATEI-BESCHREIBEN.
ACCEPT EINGABE-FELD.
PERFORM UNTIL NUMMER = 99999
MOVE SATZ TO W-SATZ
MOVE NUMMER TO W-NUMMER
DISPLAY "Waren-Nummer: " W-NUMMER
WRITE W-SATZ
IF W-IOSTAT-1 = "0"
THEN DISPLAY "Satz geschrieben"
ELSE
DISPLAY "WRITE-Fehler: " W-IOSTAT
GO TO DATEI-SCHLIESSEN
END-IF
ACCEPT EINGABE-FELD
END-PERFORM.
DISPLAY "Warendatei erstellt".
DATEI-SCHLIESSEN.
CLOSE WAREN-DATEI.
IF W-IOSTAT NOT = "00"
THEN DISPLAY "CLOSE-Fehler: " W-IOSTAT.
STOP RUN.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment