DataMuseum.dk

top - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »CREATE.PAS«

└─⟦dea633962⟧ Bits:30003306 PROMbrænder software til RC703
    └─ ⟦this⟧ »CREATE.PAS« 

TextFile

PROGRAM MASTERCREATE; æ$R-,A+,W1å
TYPE
  STR3 = STRINGÆ3Å;
  STR5 = STRINGÆ5Å;
  STR12 = STRINGÆ12Å;
  STR64 = STRINGÆ64Å;
  CHARSET = SET OF CHAR;
VAR
  SERIAL,NFILES,I: INTEGER;
  CH: CHAR;
  DCODE: STR3;
  NAME: ARRAYÆ1..20Å OF STR12;
  SF: TEXT;

FUNCTION BCD(NUMBER,DIGITS: INTEGER): STR5;
VAR
  D: INTEGER;
  B: STR5;
BEGIN
  BÆ0Å:=CHR(DIGITS);
  FOR D:=DIGITS DOWNTO 1 DO
  BEGIN
    BÆDÅ:=CHR(NUMBER MOD 10+48); NUMBER:=NUMBER DIV 10;
  END;
  BCD:=B;
END;

PROCEDURE BACKSP(N: INTEGER);
VAR
  I: INTEGER;
BEGIN
  FOR I:=1 TO N DO WRITE(^H' '^H);
END;

FUNCTION READNUM(MIN,MAX: INTEGER): INTEGER;
VAR
  N,P: INTEGER;
  OK: BOOLEAN;
  S: STR5;
BEGIN
  REPEAT
    BUFLEN:=5; READ(S);
    IF S='' THEN OK:=FALSE ELSE
    BEGIN
      VAL(S,N,P);
      OK:=(P=0) AND (N>=MIN) AND (N<=MAX);
    END;
    IF NOT OK THEN BACKSP(LEN(S));
  UNTIL OK;
  WRITELN; READNUM:=N;
END;

FUNCTION SELECT(PROMPT: STR64; OKCH: CHARSET): CHAR;
VAR
  CH: CHAR;
BEGIN
  WRITE(PROMPT);
  REPEAT
    READ(KBD,CH);
    IF (CH>='a') AND (CH<='z') THEN CH:=CHR(ORD(CH)-32);
  UNTIL CH IN OKCH;
  IF CH=^M THEN BACKSP(LEN(PROMPT)) ELSE
  BEGIN
    WRITELN(CH);
  END;
  SELECT:=CH;
END;

PROCEDURE CREATEDISK;
VAR
  NS,I: INTEGER;
  DEST: CHAR;
  S: STR5;
  CFI,CFO: FILE;
  B: ARRAYÆ0..32767Å OF BYTE;

PROCEDURE LOADBLOCK;
VAR
  L: INTEGER;
BEGIN
  L:=LENGTH(CFI)-POSITION(CFI);
  IF L>256 THEN NS:=256 ELSE NS:=L;
  IF NS>0 THEN BLOCKREAD(CFI,B,NS);
END;

PROCEDURE SAVEBLOCK;
BEGIN
  IF NS>0 THEN BLOCKWRITE(CFO,B,NS);
END;

PROCEDURE COPYFILE(FN: STR12);
BEGIN
  WRITELN('Kopierer ',FN);
  ASSIGN(CFI,'A:'+FN); RESET(CFI); LOADBLOCK;
  ASSIGN(CFO,DEST+':'+FN); REWRITE(CFO); SAVEBLOCK;
  REPEAT
    LOADBLOCK; SAVEBLOCK;
  UNTIL NS=0;
  CLOSE(CFO); CLOSE(CFI);
END;

BEGIN æCREATEDISKå
  DEST:=SELECT('Kopier til hvilken diskettestation (B-F)? ',Æ'A'..'F',^MÅ);
  IF DEST<>^M THEN
  BEGIN
    BDOS(37,-1);
    WRITELN;
    WRITELN('Serienummeret på denne kopi er ',DCODE,BCD(SERIAL,4));
    WRITELN;
    WRITELN('Kopierer COMPAS.COM');
    ASSIGN(CFI,'A:COMPAS.COM'); RESET(CFI); LOADBLOCK;
    FOR I:=1 TO 3 DO BÆI+2Å:=ORD(DCODEÆIÅ)+$57;
    S:=BCD(SERIAL,4);
    FOR I:=1 TO 4 DO BÆI+5Å:=ORD(SÆIÅ)+$57;
    ASSIGN(CFO,DEST+':COMPAS.COM'); REWRITE(CFO); SAVEBLOCK;
    REPEAT
      LOADBLOCK; SAVEBLOCK;
    UNTIL NS=0;
    CLOSE(CFO); CLOSE(CFI);
    FOR I:=1 TO NFILES DO COPYFILE(NAMEÆIÅ);
    SERIAL:=SERIAL+1;
    WRITELN;
  END;
END;

PROCEDURE SETSERIAL;
VAR
  CH: CHAR;
BEGIN
  WRITELN('Det næste serienummer er ',BCD(SERIAL,4));
  CH:=SELECT('Ønskes dette rettet (J/N)? ',Æ'J','N'Å);
  IF CH='J' THEN
  BEGIN
    WRITE('Næste serienummer? '); SERIAL:=READNUM(0,9999);
  END;
  WRITELN;
END;

BEGIN æCREATEå
  WRITELN;
  WRITELN('           COMPAS MASTER DISK KOPIERINGSPROGRAM');
  WRITELN;
  WRITELN('                   Copyright (C) 1983 by');
  WRITELN('                 Poly-Data microcenter ApS');
  WRITELN;
  WRITELN;
  ASSIGN(SF,'A:CREATE.DAT'); RESET(SF);
  READLN(SF,DCODE);
  READLN(SF,SERIAL);
  NFILES:=0;
  WHILE NOT EOF(SF) DO
  BEGIN
    NFILES:=NFILES+1; READLN(SF,NAMEÆNFILESÅ);
  END;
  CLOSE(SF);
  REPEAT
    WRITELN('VÆLG FRA DENNE MENU:');
    WRITELN;
    WRITELN('1. Kopier en ny master disk');
    WRITELN('2. Ret serienummer');
    WRITELN;
    CH:=SELECT('Funktion(1-2), Slut(S)? ',Æ'1'..'2','S'Å);
    WRITELN;
    CASE CH OF
      '1': CREATEDISK;
      '2': SETSERIAL;
    END;
  UNTIL CH='S';
  REWRITE(SF);
  WRITELN(SF,DCODE);
  WRITELN(SF,SERIAL);
  FOR I:=1 TO NFILES DO WRITELN(SF,NAMEÆIÅ);
  CLOSE(SF);
END.
«eof»