home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / various / disk_tracer2.amos / disk_tracer2.amosSourceCode
AMOS Source Code  |  1991-06-13  |  5KB  |  173 lines
  1. '
  2. ' AMOS DISK TRACER V2.0
  3. '
  4. ' made by Jurgen Valks 
  5. '
  6. '
  7. On Error Proc INIT_ERROR
  8. Shared AANMAKEN,NAAM$,ADRES$,WOONP$,GROEP$,FUNCTIE$,POS,TELLER
  9. Dir$="AMOS_COMPACT2:"
  10. Proc INIT_SCREEN
  11. Proc INIT_INLEIDING
  12. Proc CHECK_FILE
  13. '----------------------------------------------- 
  14. Procedure INIT_SCREEN
  15.    Request Off 
  16.    Break Off 
  17.    Screen Open 0,320,200,16,Lowres
  18.    Palette $0,$0,$0 : Flash Off : Curs Off 
  19.    Cls 
  20.    Screen Open 1,640,200,2,Hires
  21.    Palette $5,$5,$FFF : Flash Off : Curs Off 
  22.    Colour 1,$FFF : Pen 1 : Ink 1 : Curs Off 
  23.    Screen Display 1,,60,,
  24. End Proc
  25. Procedure INIT_INLEIDING
  26.    Locate 1,1 : Centre ">>  AMOS DISK TRACER V2.0  <<"
  27.    Locate 1,3 : Centre "De vorige versie werkte niet 100% !"
  28.    Locate 1,6 : Print "De bedoeling van dit programma is het bijhouden van gegevens van de personen"
  29.    Locate 1,8 : Print "die deze diskette in bezit hebben of hebben gehad, het is dus een soort van "
  30.    Locate 1,10 : Print "ketting-brief."
  31.    Locate 1,12 : Print "Elk persoon krijgt een nummer. Als u nummer 100 bent, stuurt u dan a.u.b. deze "
  32.    Locate 1,14 : Print "diskette op naar de auteur, u krijgt dan een nieuwe diskette terug vol met "
  33.    Locate 1,16 : Print "de nieuwste software."
  34.    Locate 1,20 : Centre "Druk op de linker muis toets"
  35.    Repeat 
  36.    Until Mouse Click=1
  37.    Cls 
  38. End Proc
  39. Procedure CHECK_FILE
  40.    If Not Exist("trace.dat")
  41.       Locate 1,1 : Centre "Er staat nog geen data file op deze diskette."
  42.       Locate 1,4 : Centre "Verwijder de write-protect beveiliging van deze diskette."
  43.       AANMAKEN=True
  44.    End If 
  45.    If Exist("trace.dat")
  46.       Locate 1,1 : Centre "Er staat een data file op deze disk."
  47.       Open Random 1,"trace.dat"
  48.       Field 1,20 As NAAM$,20 As ADRES$,25 As WOONP$,20 As GROEP$,20 As FUNCTIE$
  49.       Locate 0,3 : Print "Aantal records in file: "
  50.       POS=0
  51.       Repeat 
  52.          Inc POS
  53.          Get 1,POS
  54.          Locate 23,3 : Print Using "###";POS
  55.       Until Eof(1)
  56.    End If 
  57.    Locate 1,18 : Centre "Druk op de linker muis toets."
  58.    Wait 1
  59.    Repeat 
  60.    Until Mouse Click=1
  61.    If AANMAKEN=True Then Proc AANMAKEN
  62.    Proc HOOFD_MENU
  63. End Proc
  64. Procedure HOOFD_MENU
  65.    Cls 
  66.    Locate 1,0 : Centre ">>> Hoofdmenu <<<"
  67.    Locate 1,6 : Print "1 - Bestand bekijken."
  68.    Locate 1,8 : Print "2 - Gegevens toevoegen."
  69.    Locate 1,10 : Print "0 - Stoppen."
  70.    Locate 1,18 : Centre "Disc tracer v2.0 (c) 1991 by Jurgen Valks"
  71.    Do 
  72.       A$=Inkey$
  73.       If A$="1" Then Proc BEKIJKEN
  74.       If A$="2" Then Proc AANVULLEN
  75.       If A$="0" Then Proc EINDE
  76.    Loop 
  77. End Proc
  78. Procedure AANMAKEN
  79.    On Error Proc INIT_ERROR
  80.    Open Random 1,"trace.dat"
  81.    Field 1,20 As NAAM$,20 As ADRES$,25 As WOONP$,20 As GROEP$,20 As FUNCTIE$
  82.    NAAM$="Jurgen Valks"
  83.    ADRES$="Kerkeind 8a"
  84.    WOONP$="Gemonde"
  85.    GROEP$="Sensor"
  86.    FUNCTIE$="Coder, Gfx"
  87.    Put 1,1
  88.    POS=1
  89. End Proc
  90. Procedure BEKIJKEN
  91.    Cls : Curs Off 
  92.    TELLER=0
  93.    Repeat 
  94.       Inc TELLER
  95.       Get 1,TELLER : Cls 
  96.       Locate 1,1 : Print "Nummer           :";TELLER
  97.       Locate 1,2 : Print "Naam             : ";NAAM$
  98.       Locate 1,3 : Print "Adres            : ";ADRES$
  99.       Locate 1,4 : Print "Woonplaats       : ";WOONP$
  100.       Locate 1,5 : Print "Lid van groep    : ";GROEP$
  101.       Locate 1,6 : Print "Functie in groep : ";FUNCTIE$
  102.       Locate 1,18 : Centre "Druk op de linker muis toets."
  103.       Repeat 
  104.       Until Mouse Click=1
  105.    Until Eof(1)
  106.    Proc HOOFD_MENU
  107. End Proc
  108. Procedure AANVULLEN
  109.    On Error Proc INIT_ERROR
  110.    Cls 
  111.    Locate 0,0 : Centre "Nummer :"+Str$(POS+1)
  112.    Locate 1,2 : Input "Naam             (max. 20 tekens) [*=stop]    : ";NAAM$
  113.    If NAAM$="*"
  114.       HOOFD_MENU
  115.    End If 
  116.    Locate 1,3 : Input "Adres            (max.20)                     : ";ADRES$
  117.    Locate 1,4 : Input "Woonplaats       (max. 25 tekens)             : ";WOONP$
  118.    Locate 1,5 : Input "Lid van groep    (max. 20 tekens)             : ";GROEP$
  119.    Locate 1,6 : Input "Functie in groep (max. 20 tekens)             : ";FUNCTIE$
  120.    Inc POS
  121.    Put 1,POS
  122.    If POS=100
  123.       HEBBES
  124.    End If 
  125.    Locate 1,18 : Centre "Druk op de linker muis toets."
  126.    Repeat 
  127.    Until Mouse Click=1
  128.    Proc HOOFD_MENU
  129. End Proc
  130. Procedure INIT_ERROR
  131.    Cls 
  132.    If Errn=84
  133.       Curs Off 
  134.       Locate 1,4 : Centre "Disk is write protect, verwijder beveiliging"
  135.       Locate 1,18 : Centre "Druk op de linkse muis toets."
  136.       Repeat 
  137.       Until Mouse Click=1
  138.       Resume 
  139.    End If 
  140.    If Errn<>84
  141.       Print "Error nummer :";Errn;" is opgetreden, waarschuw de auteur."
  142.       Locate 1,18 : Centre "Druk op de linkse muis toets."
  143.       Repeat 
  144.       Until Mouse Click=1
  145.       Resume 
  146.    End If 
  147. End Proc
  148. Procedure EINDE
  149.    Cls : Close 1
  150.    Screen Close 1
  151.    Run "menu.AMOS"
  152. End Proc
  153. Procedure HEBBES
  154.    Cls 
  155.    Curs Off 
  156.    Locate 0,5 : Centre "Gefeliciteerd, u bent de 100ste persoon!!!"
  157.    Locate 0,7 : Centre "Zend deze disk met uw naam en adres naar:"
  158.    Locate 0,10 : Centre "J. Valks         "
  159.    Locate 0,11 : Centre "Kerkeind 8A      "
  160.    Locate 0,12 : Centre "5293 AB          "
  161.    Locate 0,13 : Centre "Gemonde [Holland]"
  162.    Locate 0,16 : Centre "Ik maak nu een backup van uw bestand, en wis het oude.."
  163.    Open In 2,"trace.dat"
  164.    L=Lof(2)
  165.    Reserve As Work 6,2
  166.    Close 2
  167.    Bload "trace.dat",Start(6)
  168.    Bsave "trace.full",Start(6) To Start(6)+Length(6)
  169.    Kill "trace.dat"
  170.    Erase 6
  171.    Locate 0,18 : Centre "Druk op de muis toets..."
  172.    EINDE
  173. End Proc