home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_07 / ACS_PRO.LZH / ASC / DEMO_PP.PRG / ADRESS / ADRESS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-09  |  22KB  |  517 lines
  1. {    Beispielapplikation für ACS
  2.     "Adressdatenbank"
  3.     27.09.91 Stefan Bachert (Pure C)
  4.     29.09.92 Michael Schlüter (Pure Pascal)
  5.     Letzte Änderung: 01.01.93
  6. }
  7.  
  8. PROGRAM adress;                            { Programmname }
  9.  
  10. {$X+}                { Functionen können ohne Resultat aufgerufen werden }
  11.  
  12. USES ACS, GEM, TOS;                        { benötigte Units }
  13.  
  14. PROCEDURE ad_save; FORWARD;                { Definitionen werden schon }
  15. PROCEDURE ad_leave; FORWARD;            { in ADRESS.I gebraucht }
  16. PROCEDURE ad_next; FORWARD;
  17. PROCEDURE ad_prev; FORWARD;
  18. PROCEDURE ad_first; FORWARD;
  19. PROCEDURE ad_last; FORWARD;
  20. PROCEDURE ad_new; FORWARD;
  21. PROCEDURE ad_modify; FORWARD;
  22. PROCEDURE ad_delete; FORWARD;
  23. FUNCTION ad_service( window : AwindowPtr; task : INTEGER; in_out : POINTER) : BOOLEAN; FORWARD;
  24. FUNCTION ad_make( not_used: POINTER ): AwindowPtr; FORWARD;
  25.  
  26. {$I ADRESS.I}                            { einladen der Definitionen }
  27.  
  28. CONST                                    { Vordefinierte Werte }
  29.         LAENGE        =        35;
  30.         PLZ            =        5;
  31.         TOWN        =        30;
  32.         PHONE        =        13;
  33.         BIRTHDAY    =        6;
  34.  
  35. TYPE
  36.         TRecordPtr    = ^TRecord;
  37.         TRecord     = RECORD
  38.             firstname    :    ARRAY[0..LAENGE] OF CHAR;
  39.             lastname    :    ARRAY[0..LAENGE] OF CHAR;
  40.             street        :    ARRAY[0..LAENGE] OF CHAR;
  41.             plz            :    ARRAY[0..PLZ] OF CHAR;
  42.             town        :    ARRAY[0..TOWN] OF CHAR;
  43.             phone        :    ARRAY[0..PHONE] OF CHAR;
  44.             birthday    :    ARRAY[0..BIRTHDAY] OF CHAR;
  45.             hobby        :    ARRAY[0..LAENGE + LAENGE] OF CHAR;
  46.             idea        :    ARRAY[0..LAENGE + LAENGE] OF CHAR;
  47.             dont        :    ARRAY[0..LAENGE + LAENGE] OF CHAR;
  48.         END;
  49.  
  50.         TLinkPtr    = ^TLink;
  51.         TLink         = RECORD
  52.             next        :    TLinkPtr;
  53.             prev        :    TLinkPtr;
  54.             ad_record    :    TRecordPtr;
  55.         END;
  56.  
  57.         TAd_DbPtr    = ^TAd_Db;
  58.         TAd_Db        = RECORD
  59.             n            :    INTEGER;
  60.             act_index    :    INTEGER;
  61.             act            :    TLinkPtr;
  62.             first        :    TLinkPtr;
  63.             last        :    TLinkPtr;
  64.             path        :    STRING;
  65.         END;
  66.  
  67. VAR
  68.         path    :    STRING;                { Zwischenspeicher für den Pfad }
  69.         proto    :    TRecord;            { Falls keine Daten geladen werden }
  70.  
  71. { ----------------------------------------------------------------- }
  72. { Nimmt die Auswahl der zu ladenden Datei vor (mit Dateiauswahlbox) }
  73. { ----------------------------------------------------------------- }
  74. FUNCTION fileselect : STRING;
  75. VAR        name    : STRING;                { Name der Datei }
  76.         button    : INTEGER;                { gedrückte Button }
  77.  
  78.     { * Löscht einen Dateinamen aus dem übergebenen Pfad * }
  79.     PROCEDURE pfad_select_entf( VAR pfad : STRING );
  80.     VAR     p        : BYTE;                { Buchstabenzähler }
  81.     BEGIN
  82.         p := LENGTH(pfad);                { stelle Länge des Pfades fest }
  83.         WHILE ( pfad[p] <> '\' ) DO        { Wiederhole bis '\' gefunden }
  84.             DEC(p);                        { Nächstes Zeichen }
  85.         pfad[0] := CHR(p);                { Länge anpassen }
  86.     END;
  87.  
  88. BEGIN
  89.     pfad_select_entf(path);                { Alten Dateinamen löschen }
  90.     name := '';                            { Kein Name vorwählen }
  91.     path := path + '*.ADB';                { Nur nach Datenbanken suchen }
  92.     Aev_unhidepointer;                    { Der Mauszeiger wird wieder sichtbar }
  93.     IF ((Fsel_input(path, name, button) = 0) OR
  94.         (button = 0) OR (LENGTH(name) = 0)) THEN
  95.                                         { Wenn kein Speicher für Dateiauswahlbox }
  96.                                         { oder Abbruch oder kein Dateiname }
  97.         fileselect := ''                { nichts zurückgeben }
  98.     ELSE
  99.     BEGIN
  100.         IF ((LENGTH(name) = 9) AND (name[8] = '.')) THEN
  101.                                         { Wenn Dateiname + '.' }
  102.             name := name + 'ADB';        { dann Extension anhängen }
  103.         IF (POS('.', name) = 0) THEN    { Wenn kein '.' }
  104.             name := name + '.ADB';        { dann Extension mit '.' anhängen }
  105.         pfad_select_entf(path);            { Pfad wieder zurückkürzen }
  106.         fileselect := path + name;        { Pfad mit Dateinamen zurückgeben }
  107.     END;
  108. END;
  109.  
  110. { ----------------------------------------------------------------- }
  111. { Daten in die Dialogbox eintragen                                    }
  112. { ----------------------------------------------------------------- }
  113. PROCEDURE ad_set( window : AwindowPtr );
  114. VAR        user    : TAd_DbPtr;            { Pointer auf Userrec. einer Datenbank }
  115.         xrekord    : TRecordPtr;            { Pointer auf einen Datensatz }
  116.         work    : AESTreePtr;            { Pointer auf den Objectbaum }
  117.         nr         : STRING;                { String für Datensatznummer }
  118. BEGIN
  119.     user := window^.user;                { Pointer auf Userrecord holen }
  120.     work := AESTreePtr(window^.work);    { Pointer auf Objectbaum holen }
  121.     IF (user^.act = NIL) THEN xrekord := @proto
  122.                             { Wenn keine DB geladen, dann leeren Datens. nehmen }
  123.     ELSE xrekord := user^.act^.ad_record;{ Sonst aktuellen Datens. nehmen }
  124.     STR(user^.act_index, nr);            { Datensatznummer in String umwandeln }
  125.     nr := ' ' + nr + ' ';                { Leerzeichen einfügen }
  126.     SetPtext(work, AD_INDEX, nr);        { Und in den Objectrecord einbauen }
  127.                                 { Daten aus dem Record in das Object kopieren: }
  128.     Move(xrekord^.firstname, work^[AD_FIRSTNAME].ob_spec.ted_info^.te_ptext^, LAENGE);
  129.     Move(xrekord^.lastname, work^[AD_LASTNAME].ob_spec.ted_info^.te_ptext^, LAENGE);
  130.     Move(xrekord^.street, work^[AD_STREET].ob_spec.ted_info^.te_ptext^, LAENGE);
  131.     Move(xrekord^.plz, work^[AD_PLZ].ob_spec.ted_info^.te_ptext^, PLZ);
  132.     Move(xrekord^.town, work^[AD_TOWN].ob_spec.ted_info^.te_ptext^, TOWN);
  133.     Move(xrekord^.phone, work^[AD_PHONE].ob_spec.ted_info^.te_ptext^, PHONE);
  134.     Move(xrekord^.birthday, work^[AD_BIRTHDAY].ob_spec.ted_info^.te_ptext^, BIRTHDAY);
  135.     Move(xrekord^.hobby, work^[AD_1HOBBY].ob_spec.ted_info^.te_ptext^, LAENGE);
  136.     Move(xrekord^.hobby[LAENGE], work^[AD_2HOBBY].ob_spec.ted_info^.te_ptext^, LAENGE);
  137.     Move(xrekord^.idea, work^[AD_1IDEA].ob_spec.ted_info^.te_ptext^, LAENGE);
  138.     Move(xrekord^.idea[LAENGE], work^[AD_2IDEA].ob_spec.ted_info^.te_ptext^, LAENGE);
  139.     Move(xrekord^.dont, work^[AD_1DONTS].ob_spec.ted_info^.te_ptext^, LAENGE);
  140.     Move(xrekord^.dont[LAENGE], work^[AD_2DONTS].ob_spec.ted_info^.te_ptext^, LAENGE);
  141.     Awi_diaend;                            { Textcursor entfernen }
  142.     window^.OB_COL := -1;                { Textcursor an letzte Position }
  143.     window^.redraw(window, @window^.wi_work);{ Dialog updaten }
  144.     Awi_diastart;                        { Textcursor darstellen }
  145. END;
  146.  
  147. { ----------------------------------------------------------------- }
  148. { Daten aus der Dialogbox holen                                        }
  149. { ----------------------------------------------------------------- }
  150. PROCEDURE ad_get(window : AwindowPtr);
  151. VAR        user    : TAd_DbPtr;            { Pointer auf Userrec. einer Datenbank }
  152.         xrekord    : TRecordPtr;            { Pointer auf einen Datensatz }
  153.         work    : AESTreePtr;            { Pointer auf den Objectbaum }
  154. BEGIN
  155.     user := window^.user;                { Pointer auf Userrecord holen }
  156.     work := AESTreePtr(window^.work);    { Pointer auf Objectbaum holen }
  157.     xrekord := user^.act^.ad_record;    { Aktuellen Datensatz nehmen }
  158.     Move(work^[AD_FIRSTNAME].ob_spec.ted_info^.te_ptext^, xrekord^.firstname, LAENGE);
  159.     Move(work^[AD_LASTNAME].ob_spec.ted_info^.te_ptext^, xrekord^.lastname, LAENGE);
  160.     Move(work^[AD_STREET].ob_spec.ted_info^.te_ptext^, xrekord^.street, LAENGE);
  161.     Move(work^[AD_PLZ].ob_spec.ted_info^.te_ptext^, xrekord^.plz, PLZ);
  162.     Move(work^[AD_TOWN].ob_spec.ted_info^.te_ptext^, xrekord^.town, TOWN);
  163.     Move(work^[AD_PHONE].ob_spec.ted_info^.te_ptext^, xrekord^.phone, PHONE);
  164.     Move(work^[AD_BIRTHDAY].ob_spec.ted_info^.te_ptext^, xrekord^.birthday, BIRTHDAY);
  165.     Move(work^[AD_1HOBBY].ob_spec.ted_info^.te_ptext^, xrekord^.hobby, LAENGE);
  166.     Move(work^[AD_2HOBBY].ob_spec.ted_info^.te_ptext^, xrekord^.hobby[LAENGE], LAENGE);
  167.     Move(work^[AD_1IDEA].ob_spec.ted_info^.te_ptext^, xrekord^.idea, LAENGE);
  168.     Move(work^[AD_2IDEA].ob_spec.ted_info^.te_ptext^, xrekord^.idea[LAENGE], LAENGE);
  169.     Move(work^[AD_1DONTS].ob_spec.ted_info^.te_ptext^, xrekord^.dont, LAENGE);
  170.     Move(work^[AD_2DONTS].ob_spec.ted_info^.te_ptext^, xrekord^.dont[LAENGE], LAENGE);
  171. END;
  172.  
  173.  
  174. { ----------------------------------------------------------------- }
  175. { Daten auf einen Datenträger sichen                                }
  176. { ----------------------------------------------------------------- }
  177. PROCEDURE ad_save;
  178. VAR        user    : TAd_DbPtr;            { Pointer auf Userrec. einer Datenbank }
  179.         datei    : FILE OF TRecord;        { Variable für Dateihandling }
  180.         link    : TLinkPtr;                { Record von Pointern auf Datensätze }
  181. BEGIN
  182.     user := ev_window^.user;            { Pointer auf User-Record holen }
  183.     Assign(datei, copy(user^.path, 2, LENGTH(user^.path)-1));
  184.                                         { Datei zuweisen }
  185.     {$I-}                                { Überprüfung auf IO-Fehler aus }
  186.     Rewrite(datei);                        { Neue Datei - alte Daten löschen }
  187.     {$I+}                                { Überprüfung auf IO-Fehler an }
  188.     IF IOResult <> 0 THEN EXIT;            { Wenn Fehler, dann Procedure beenden }
  189.     link := user^.first;                { Auf ersten Link setzten }
  190.     WHILE (link <> NIL) DO                { Wiederhole bis letzter Link }
  191.     BEGIN
  192.         Blockwrite(datei, link^.ad_record^, 1);
  193.                                         { Datensatz auf Datenträger speichern }
  194.         link := link^.next;                { Zum nächsten Link }
  195.     END;
  196.     close(datei);                        { Datei wieder schlie₧en }
  197. END;
  198.  
  199. { ----------------------------------------------------------------- }
  200. { Nächsten Datensatz anzeigen                                        }
  201. { ----------------------------------------------------------------- }
  202. PROCEDURE ad_next;
  203. VAR        user    : TAd_DbPtr;            { Pointer auf Userecord einer Datenb. }
  204.         link    : TLinkPtr;                { Record von Pointer auf Datensatz }
  205. BEGIN
  206.     user := ev_window^.user;            { Userecord holen }
  207.     link := user^.act;                    { Linkrecord holen }
  208.     IF (link <> NIL) AND (link^.next <> NIL) THEN
  209.     BEGIN                    { Wenn Link vorhanden und es einen nächsten DS gibt }
  210.         INC(user^.act_index);            { Indexnummer erhöhen }
  211.         user^.act := link^.next;        { Nächste Datensatz ist nun aktuelle Datensatz }
  212.         ad_set(ev_window);                { Daten in das Object eintragen }
  213.     END;
  214. END;
  215.  
  216. { ----------------------------------------------------------------- }
  217. { Vorherigen Datensatz anzeigen                                        }
  218. { ----------------------------------------------------------------- }
  219. PROCEDURE ad_prev;
  220. VAR        user    : TAd_DbPtr;            { Pointer auf Userecord einer Datenb. }
  221.         link    : TLinkPtr;                { Record von Pointer auf Datensatz }
  222. BEGIN
  223.     user := ev_window^.user;            { Userecord holen }
  224.     link := user^.act;                    { Linkrecord holen }
  225.     IF (link <> NIL) AND (link^.prev <> NIL) THEN
  226.     BEGIN                    { Wenn Link vorhanden und es einen vorherigen DS gibt }
  227.         DEC(user^.act_index);            { Indexnummer erniedrigen }
  228.         user^.act := link^.prev;        { Vorherige Datensatz ist nun aktuelle Datensatz }
  229.         ad_set(ev_window);                { Daten in das Object eintragen }
  230.     END;
  231. END;
  232.  
  233. { ----------------------------------------------------------------- }
  234. { Ersten Datensatz anzeigen                                            }
  235. { ----------------------------------------------------------------- }
  236. PROCEDURE ad_first;
  237. VAR        user    : TAd_DbPtr;            { Pointer auf Userecord einer Datenb. }
  238.         act        : TLinkPtr;                { Record von Pointer auf Datensatz }
  239. BEGIN
  240.     user := ev_window^.user;            { Userecord holen }
  241.     act := user^.act;                    { Linkrecord holen }
  242.     IF (act <> NIL) AND (act^.prev <> NIL) THEN
  243.     BEGIN                    { Wenn Link vorhanden und nicht schon erster DS  }
  244.         user^.act_index := 1;            { Indexnummer = 1 }
  245.         user^.act := user^.first;        { Erste Datensatz ist nun aktuelle Datensatz }
  246.         ad_set(ev_window);                { Daten in das Object eintragen }
  247.     END;
  248. END;
  249.  
  250. { ----------------------------------------------------------------- }
  251. { Letzten Datensatz anzeigen                                        }
  252. { ----------------------------------------------------------------- }
  253. PROCEDURE ad_last;
  254. VAR        user    : TAd_DbPtr;            { Pointer auf Userecord einer Datenb. }
  255.         act        : TLinkPtr;                { Record von Pointer auf Datensatz }
  256. BEGIN
  257.     user := ev_window^.user;            { Userecord holen }
  258.     act := user^.act;                    { Linkrecord holen }
  259.     IF (act <> NIL) AND (act^.next <> NIL) THEN
  260.     BEGIN                    { Wenn Link vorhanden und nicht schon letzter DS  }
  261.         user^.act_index := user^.n;        { Indexnummer = letzte DSnummer }
  262.         user^.act := user^.last;        { Letzte Datensatz ist nun aktuelle Datensatz }
  263.         ad_set(ev_window);                { Daten in das Object eintragen }
  264.     END;
  265. END;
  266.  
  267. { ----------------------------------------------------------------- }
  268. { Neuen Datensatz eingeben                                            }
  269. { ----------------------------------------------------------------- }
  270. PROCEDURE ad_new;
  271. VAR        user        : TAd_DbPtr;        { Pointer auf Userrec. einer Datenbank }
  272.         act, new    : TLinkPtr;            { Record von Pointer auf Datensätze }
  273.         xrecord        : TRecordPtr;        { Pointer auf Datensatz }
  274.         window        : AwindowPtr;        { Pointer auf Fensterrecord }
  275. BEGIN
  276.     window := ev_window;                { Fensterrecordpointer holen }
  277.     user := window^.user;                { Pointer auf User-Record holen }
  278.     new := Ax_malloc(SizeOf(TLink));    { Speicher für Link anfordern }
  279.     IF new = NIL THEN EXIT;                { Wenn kein freier Speicher -> abbruch }
  280.     xrecord := Ax_malloc(SizeOf(TRecord));{ Speicher für Datenrecord anfordern }
  281.     IF xrecord = NIL THEN EXIT;            { Wenn kein freier Speicher -> abbruch }
  282.     act := user^.act;                    { Aktuellen Link holen }
  283.     new^.ad_record := xrecord;            { Adresse des Datensatzes sichern }
  284.     user^.act := new;                    { Neue DS = aktuelle DS }
  285.     INC(user^.act_index);                { Erhöhe den index }
  286.     INC(user^.n);                        { Erhöhe die Anzahl d. DS }
  287.     new^.prev := act;                    { Aktuelle DS ist vorgänger des neuen DS }
  288.     IF act = NIL THEN                    { Wenn kein aktueller DS dann ... }
  289.     BEGIN
  290.         user^.first := new;                { Neuer DS = erster DS }
  291.         user^.last := new;                {    "     = letzter DS }
  292.         new^.next := NIL;                { Und kein nächster DS }
  293.     END
  294.     ELSE                                 { Sonst ... }
  295.     BEGIN
  296.         new^.next := act^.next;            { Nächster DS = nächster DS vom aktuellen DS }
  297.         act^.next := new;                { Nächste DS vom aktuellen DS = neuer DS }
  298.         IF new^.next <> NIL THEN        { Wenn es einen nächsten DS gibt ... }
  299.             new^.next^.prev := new        { Dann dort den neuen als vorgänger eintragen }
  300.         ELSE                            { Sonst ... }
  301.             user^.last := new;            { Ist der neue DS = der letzte DS }
  302.     END;
  303.     ad_get(window);                        { Daten aus dem Object auslesen }
  304.     ad_set(window);                        { Daten in Object eintragen und ausgeben }
  305. END;
  306.  
  307. { ----------------------------------------------------------------- }
  308. { Veränderten Datensatz übernehmen                                    }
  309. { ----------------------------------------------------------------- }
  310. PROCEDURE ad_modify;
  311. BEGIN
  312.     ad_get(ev_window);                    { Daten aus Object auslesen }
  313. END;
  314.  
  315. { ----------------------------------------------------------------- }
  316. { Datensatz löschen                                                    }
  317. { ----------------------------------------------------------------- }
  318. PROCEDURE ad_delete;
  319. VAR     user         : TAd_DbPtr;        { Pointer auf Userrec. einer Datenbank }
  320.         act, p, n    : TLinkPtr;            { Record von Pointern auf Datensätze }
  321. BEGIN
  322.     user := ev_window^.user;            { Pointer auf User-Record holen }
  323.     act := user^.act;                    { Pointer auf aktuellen Link holen }
  324.     IF act = NIL THEN EXIT;                { Wenn kein DS mehr vorhanden }
  325.     p := act^.prev;                        { Vorherigen Link holen }
  326.     n := act^.next;                        { Nächsten Link holen }
  327.     IF p = NIL THEN                     { Wenn kein vorheriger Link }
  328.         user^.first := n                { Dann der Nächste = der Erste }
  329.     ELSE
  330.         p^.next := n;                    { Sonst der Nächste = der Nächste }
  331.     IF n = NIL THEN                        { Wenn kein nächste Link }
  332.     BEGIN
  333.         user^.last := p;                { Der Letzte = Vorherige }
  334.         user^.act := p;                    { Der Aktuelle = Vorherige }
  335.         DEC(user^.act_index);            { Index an aktuellen Datensatz anpassen }
  336.     END
  337.     ELSE
  338.     BEGIN
  339.         user^.act := n;                    { Der Aktuelle = der Nächste }
  340.         n^.prev := p;                    { Der Vorherige = der Vorherige }
  341.     END;
  342.     DEC(user^.n);                        { Ein Datensatz weniger }
  343.     Ax_free(act^.ad_record);            { Speicher für Record wieder freigeben }
  344.     Ax_free(act);                        { Speicher für Link wieder freigeben }
  345.     Ad_set(ev_window);                    { Daten in Object eintragen und ausgeben }
  346. END;
  347.  
  348.  
  349. { ----------------------------------------------------------------- }
  350. { Läd die Daten einer Datenbank von einem Datenträger                }
  351. { ----------------------------------------------------------------- }
  352. PROCEDURE load( window : AwindowPtr );
  353. LABEL    FEHLER;                            { Sprungmarke bei einem Fehler }
  354. VAR        user        : TAd_DbPtr;        { Pointer auf Userrec. einer Datenbank }
  355.         datei        : FILE OF TRecord;    { Variable für Dateihandling }
  356.         link, prev    : TLinkPtr;            { Record von Pointern auf Datensätze }
  357.         xrecord        : TRecordPtr;        { Pointer auf Datensatz }
  358.         loops        : LONGINT;            { Zwischenspeicher Anzahl d. Datensätze }
  359. BEGIN
  360.     user := window^.user;                { Pointer auf User-Record holen }
  361.     user^.n := 0;                        { Enthält bisher keinen Datens. }
  362.     user^.act_index := 0;                { Keinen aktueller Datensatz }
  363.     user^.act := NIL;                    { Keinen aktuellen Datensatz }
  364.     user^.first := NIL;                    { Keinen ersten Datensatz }
  365.     user^.last := NIL;                    { Keinen letzten Datensatz }
  366.     
  367.     Assign(datei, copy(user^.path, 2, LENGTH(user^.path) - 1));
  368.                                         { Datei zuweisen }
  369.     {$I-}                                { Überprüfung auf IO-Fehler aus }
  370.     Reset(datei);                        { Datei öffnen }
  371.     {$I+}                                { Überprüfung auf IO-Fehler an }
  372.     IF IOResult <> 0 THEN EXIT;            { Wenn Fehler, dann beende Procedure }
  373.     prev := NIL;                        { Kein vorheriger Datensatz }
  374.     loops := Filesize(datei);            { Anzahl der Datensätze -> loops }
  375.     WHILE ( user^.n < loops ) DO        { Wiederhole bis alle Datensätze gelesen }
  376.     BEGIN
  377.         xrecord := Ax_malloc(SizeOf(TRecord));
  378.                                         { Speicher für einen TRecord bereitst. }
  379.         IF (xrecord = NIL) THEN GOTO FEHLER;
  380.                                         { Wenn Fehler dann Schleife abbrechen }
  381.         link := Ax_malloc(SizeOf(TLink));{ Speicher für einen TLink bereitst. }
  382.         IF (link = NIL) THEN GOTO FEHLER;{ Wenn Fehler dann Schleife abbrechen }
  383.         BlockRead(datei, xrecord^, 1);    { Lese Datensatz von Datenträger ein }
  384.         INC(user^.n);                    { Erhöhe Datensatzzähler }
  385.         link^.ad_record := xrecord;        { Adresse des Datensatzrecords abspeichern }
  386.         IF (prev = NIL) THEN            { Wenn erste Datensatz }
  387.             user^.first := link            { dann im user-Record abspeicher }
  388.         ELSE
  389.             prev^.next := link;            { sonst in Pointerkette einreihen }
  390.         link^.prev := prev;                { vorherigen eintragen }
  391.         prev := link;                    { aktuelle ist vorherige }
  392.     END;
  393. FEHLER:                                    { im Fehlerfall ist man hier richtig }
  394.     IF (user^.n <> 0) THEN                { Wenn mind. ein Datensatz geladen }
  395.     BEGIN
  396.         prev^.next := NIL;                { kein nächster Datensatz }
  397.         user^.last := prev;                { letzte ist letzter Datensatz }
  398.         user^.act_index := 1;            { erste ist aktuelle Datensatz }
  399.         user^.act := user^.first;        { erste ist aktuelle Datensatz }
  400.     END;
  401.     Close(datei);                        { Schlie₧e Datei }
  402. END;
  403.  
  404. { ----------------------------------------------------------------- }
  405. { Beendet die Bearbeitung eines Datenbankfensters                    }
  406. { ----------------------------------------------------------------- }
  407. PROCEDURE term( window : AwindowPtr );
  408. VAR        user        : TAd_DbPtr;        { Pointer auf Userrec. einer Daten B. }
  409.         link, temp    : TLinkPtr;            { Record von Pointern auf Datensätze }
  410. BEGIN
  411.     user := window^.user;                { Pointer auf User-Record holen }
  412.     link := user^.first;                { Erste Link eines Datensatz holen }
  413.     while (link <> NIL) DO                { Wiederhole bis keine Link mehr da }
  414.     BEGIN
  415.         temp := link^.next;                { Nächsten Link zwischensp. }
  416.         Ax_free(link^.ad_record);        { Gebe Speicher eines Datens. frei }
  417.         Ax_free(link);                    { Gebe Speicher eine Links frei }
  418.         link := temp;                    { Zum nächsten Link }
  419.     END;
  420.  
  421.     Ax_free(user);                        { User-Record freigeben }
  422.     Awi_delete(window);                    { Fenster-Record freigeben }
  423. END;
  424.  
  425. { ----------------------------------------------------------------- }
  426. { Ein Datenbankenfenster soll geschlossen werden                    }
  427. { ----------------------------------------------------------------- }
  428. PROCEDURE ad_leave;
  429. BEGIN
  430.     term(ev_window);                    { Lösche Adr. Datenbank mit Fenster }
  431. END;
  432.  
  433. { ----------------------------------------------------------------- }
  434. { Routine, die die Nachrichten vom ACS bearbeitet                    }
  435. { ----------------------------------------------------------------- }
  436. FUNCTION ad_service( window : AwindowPtr; task : INTEGER; in_out : POINTER) : BOOLEAN;
  437. BEGIN
  438.     CASE task OF
  439.         AS_TERM: term(window);            { Fenster soll geschlossen werden }
  440.         ELSE BEGIN
  441.             ad_service := FALSE;        { Message nicht bearbeitet }
  442.             EXIT;
  443.         END;
  444.     END;
  445.     ad_service := TRUE;                    { Message wurde bearbeitet }
  446. END;
  447.  
  448. { ----------------------------------------------------------------- }
  449. { Öffne ein Fenster und was sonst noch gemacht werden mu₧            }
  450. { ----------------------------------------------------------------- }
  451. FUNCTION ad_make( not_used : POINTER ): AwindowPtr;
  452. VAR        p         : STRING;
  453.         wi        : AwindowPtr;
  454.         user    : TAd_DbPtr;
  455. BEGIN
  456.     p := fileselect;                    { Datei auswählen }
  457.     IF (LENGTH(p) <> 0) THEN            { Wenn eine Datei ausgewählt }
  458.     BEGIN
  459.         user := Ax_malloc(SizeOf(TAd_Db)); { Speicher für Userblockrec. bereitstellen }
  460.         IF (user = NIL) THEN
  461.             ad_make := NIL                { Kein Speicher bekommen }
  462.         ELSE
  463.         BEGIN
  464.             wi := Awi_create(@ADDRESS);    { Fenster wird erzeugt }
  465.             IF (wi = NIL) THEN
  466.                 ad_make := NIL            { Fehler beim Erzeugen }
  467.             ELSE
  468.             BEGIN
  469.                 wi^.user := user;        { Userblockrec. in Windowrec. sichern }
  470.                 user^.path := ' ' + p + CHR(0);
  471.                                         { Pfad in Userblockrec. sichern (C-Spez.)}
  472.                 Ast_delete(wi^.info);    { Alten Infotext löschen }
  473.                 wi^.info := Ast_create(@user^.path[1]);
  474.                                         { Neuen Infotext erzeugen }
  475.                                         { Pfad soll Infotext im Fenster sein }
  476.                 load(wi);                { Daten laden }
  477.                 ad_set(wi);                { Daten in den Dialog einsetzen }
  478.                 wi^.open(wi);            { Fenster gleich öffnen }
  479.                 ad_make := wi;            { Adresse d. Windowrecords zurückgeben }
  480.             END;
  481.         END;
  482.     END
  483.     ELSE
  484.         ad_make := NIL;                    { Keine Datei ausgewählt }
  485. END;
  486.  
  487. { ----------------------------------------------------------------- }
  488. { Initialisieren der Applikation                                    }
  489. { ----------------------------------------------------------------- }
  490. FUNCTION init_acs: INTEGER;
  491. VAR        wi             : AwindowPtr;        { Erzeuge einen Pointer auf Awindow }
  492.         akt_path    : STRING;            { Zwischenspeichern des akt. Pfades }
  493. BEGIN
  494.     { ** Erstmal den aktuellen Pfad ermitteln und sichern ** }
  495.     path := 'A:';                        { Laufwerk vorgeben }
  496.     path[1] := CHR(ORD(path[1]) + Dgetdrv);
  497.                                         { Akt. Laufwerk ermitteln }
  498.     Dgetpath(akt_path, 0);                { Akt. Pfad ermitteln }
  499.     IF (LENGTH(akt_path) = 0) THEN        { Wenn kein Pfad zurückgegeben }
  500.         akt_path := '\';                { dann nehmen wir den Obersten }
  501.     path := path + akt_path;            { Und in die globale Variable kopieren }
  502.  
  503.     { ** Nun das Root-Window mit der Create-Routine anmelden ** }
  504.     wi := Awi_root;                        { Hole Pointer auf Rootwindow }
  505.     IF (wi <> NIL) THEN                    { Zeiger OK? }
  506.     BEGIN
  507.         wi^.service (wi, AS_NEWCALL, @@ADDRESS.create);
  508.                                         { Routine für Neu-Ikon einsetzten }
  509.         init_acs := OK;                    { Alles richtig gelaufen }
  510.     END
  511.     ELSE
  512.         init_acs := FAIL;                { Fehler aufgetreten }
  513. END;
  514.  
  515. BEGIN                                    { Programmstart }
  516.     start_acs(init_acs, @ACSdescr);        { ACS starten }
  517. END.                                    { Programmende }