' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' Wilfried Cordes, Kennedystraže 20, 2900 Oldenburg, Tel.: 0441-53088
' Accessory/Programm zur Dateisuche
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' 4000 Bytes Speicher reichen
$m4000
RESERVE 4000
'
ersetzegewicht&=3
einfuegegewicht&=1
entfernegewicht&=6
jokergewicht&=1
DIM passende_datei$(10),kleinstes_gewicht&(10),d&(12,12)
'
' Mauszeiger normalisieren
DEFMOUSE 0
' *
' * Anwendung beim AES anmelden
' *
ap_id&=APPL_INIT()
programm!=ap_id&=0             !normales Programm
'
IF NOT programm!
  ' *
  ' * Accessorynamen ins Deskmen eintragen
  ' *
  IF MENU_REGISTER(ap_id&,"  Dateisuche...")=-1
    ' Kein Platz im Deskmen; fassen wir uns in Geduld
    DO
      ~EVNT_TIMER(-1)
    LOOP
  ENDIF
ENDIF
' *
' * Ressourcebaumadressen holen
' *
INLINE rsc%,4178
tabelle&=CARD{rsc%+18}
'
suche_adr%={tabelle&+rsc%}+rsc%
setze_koordinaten(suche_adr%,rsc%)
nachfrage&=2
rechte&=4
dateiname&=6
laufwerk_a&=8
laufwerk_c_plus&=34
start&=35
loeschen&=36
abbruch&=37
leven&=38
'
aktuell_adr%={tabelle&+rsc%+4}+rsc%
setze_koordinaten(aktuell_adr%,rsc%)
aktueller_pfad&=2
'
gefunden_adr%={tabelle&+rsc%+8}+rsc%
setze_koordinaten(gefunden_adr%,rsc%)
weiter&=2
uebergehen&=3
schluss&=4
pfad1&=5
pfad2&=6
bytes&=8
oeffne&=10
'
rechte_adr%={tabelle&+rsc%+12}+rsc%
setze_koordinaten(rechte_adr%,rsc%)
ersetze_gew&=16
einfuege_gew&=15
entferne_gew&=17
joker_gew&=18
'
LET liste_adr%={tabelle&+rsc%+16}+rsc%
setze_koordinaten(liste_adr%,rsc%)
LET liste_datei1&=7
LET liste_distanz1&=18
'
pfad%=MALLOC(200)
erw%=MALLOC(13)
LET name%=MALLOC(9)
CHAR{name%}="SUCHE   "
msgpuffer%=MALLOC(16)                      !Nachrichtenpuffer
WORD{msgpuffer%+2}=ap_id&
WORD{msgpuffer%+4}=0
' *
' * Endlosschleife fr Accessories
' *
DO
  verstecke(gefunden_adr%,oeffne&)
  IF NOT programm!
    oeffnen!=FALSE              !Botschaft an GEMINI
    ~EVNT_MESAG(0)              !Auf's angeklickt werden warten
    SELECT MENU(1)              !Botschaft 'AC_OPEN' eingetroffen
    CASE 40
      {msgpuffer%+12}=name%
      WORD{msgpuffer%}=&H4700
      IF APPL_WRITE(0,16,msgpuffer%)<>0      !Hauptprogramm fragen
        IF EVNT_MULTI(&X110000,0,0,0,1,2,3,4,5,1,2,3,4,5,0,700)=&X10000 !Botschaft?
          IF MENU(1)=&H4701                  !Status
            IF BTST(MENU(4),4)               !Fenster ”ffnen m”glich?
              show(gefunden_adr%,oeffne&)    !Ja
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      '
      fuehre_dialog
      '
      IF oeffnen!
        WORD{msgpuffer%}=&H4720
        {msgpuffer%+6}=pfad%
        {msgpuffer%+10}=erw%
        ~APPL_WRITE(0,16,msgpuffer%)
      ENDIF
      '
    CASE &H6200
      ' *
      ' * Anfrage eines anderen Programms auf Vorhandensein
      ' *
      main_app&=MENU(2)
      WORD{msgpuffer%}=&H6201
      ~APPL_WRITE(main_app&,16,msgpuffer%)
      '
    CASE &H6202
      ' *
      ' * Suchauftrag
      ' *
      ~FORM_ALERT(1,"[1][&H6202 erhalten.|Starte Suche.][Okay]")
    ENDSELECT
  ELSE
    fuehre_dialog
  ENDIF
  '
  EXIT IF programm!
LOOP
'
' Programmende (ein Accessory darf nicht beendet werden.)
~MFREE(name%)
~MFREE(pfad%)
~MFREE(msgpuffer%)
~MFREE(erw%)
~RSRC_FREE()
END
' *
' * Dateidialogbox verwalten
' *
PROCEDURE fuehre_dialog
  dta%=MALLOC(900)            !Puffer fr DTA's (maximale Baumtiefe 20)
  IF dta%=0
    ~FORM_ALERT(1,"[3][Speichermangel][Abbruch]")
  ELSE
    ' Menleiste sperren
    ~WIND_UPDATE(1)
    '
    ' Dialogboxen auf Bildschirm zentrieren
    ~FORM_CENTER(gefunden_adr%,x&,y&,b&,h&)
    ~FORM_CENTER(suche_adr%,x&,y&,b&,h&)
    ~FORM_CENTER(aktuell_adr%,xx&,y&,bb&,h&)
    ~FORM_CENTER(rechte_adr%,x&,yy&,b&,hh&)
    ~FORM_CENTER(liste_adr%,x&,y&,b&,h&)
    '
    ' Bildschirmplatz reservieren
    ~FORM_DIAL(0,0,0,0,0,xx&,yy&,bb&,hh&)
    '
    ' In Eingabezeile eine Null (Endekennung) schreiben
    BYTE{{OB_SPEC(suche_adr%,dateiname&)}}=0
    '
    ' Nur vorhandene Laufwerke zeigen
    laufwerksliste%=BIOS(10)
    FOR m&=0 TO 25
      IF BTST(laufwerksliste%,m&)
        ' Laufwerksknopf zeigen
        OB_FLAGS(suche_adr%,m&+laufwerk_a&)=BCLR(OB_FLAGS(suche_adr%,m&+laufwerk_a&),7)
      ELSE
        ' Laufwerksknopf verstecken
        OB_FLAGS(suche_adr%,m&+laufwerk_a&)=BSET(OB_FLAGS(suche_adr%,m&+laufwerk_a&),7)
      ENDIF
    NEXT m&
    IF BTST(laufwerksliste%,2)
      OB_FLAGS(suche_adr%,laufwerk_c_plus&)=BCLR(OB_FLAGS(suche_adr%,laufwerk_c_plus&),7)
    ELSE
      OB_FLAGS(suche_adr%,laufwerk_c_plus&)=BSET(OB_FLAGS(suche_adr%,laufwerk_c_plus&),7)
    ENDIF
    '
    ' Aktuelles Laufwerk vorselektieren
    selektiere(suche_adr%,GEMDOS(25)+laufwerk_a&)
    '
    REPEAT
      abbruch!=FALSE
      selektiere(suche_adr%,nachfrage&)
      '
      ' Dialogbox zeichnen
      ~OBJC_DRAW(suche_adr%,0,8,xx&,yy&,bb&,hh&)
      '
      ' Dialog durchfhren (Bit 15 zeigt Doppelklick an, der wird hier aber
      '                     nicht ausgewertet)
      r_obj&=BCLR(CARD(FORM_DO(suche_adr%,0)),15)
      entfaerbe(suche_adr%,r_obj&)
      '
      ' Je nach Benutzerwunsch verzweigen
      SELECT r_obj&
      CASE rechte&
        ' Hilfsdialogbox zeigen
        CHAR{{OB_SPEC(rechte_adr%,ersetze_gew&)}}=STR$(ersetzegewicht&)
        CHAR{{OB_SPEC(rechte_adr%,einfuege_gew&)}}=STR$(einfuegegewicht&)
        CHAR{{OB_SPEC(rechte_adr%,entferne_gew&)}}=STR$(entfernegewicht&)
        CHAR{{OB_SPEC(rechte_adr%,joker_gew&)}}=STR$(jokergewicht&)
        '
        ~OBJC_DRAW(rechte_adr%,0,3,xx&,yy&,bb&,hh&)
        entfaerbe(rechte_adr%,FORM_DO(rechte_adr%,0))
        '
        jokergewicht&=VAL(CHAR{{OB_SPEC(rechte_adr%,joker_gew&)}})
        entfernegewicht&=VAL(CHAR{{OB_SPEC(rechte_adr%,entferne_gew&)}})
        einfuegegewicht&=VAL(CHAR{{OB_SPEC(rechte_adr%,einfuege_gew&)}})
        ersetzegewicht&=VAL(CHAR{{OB_SPEC(rechte_adr%,ersetze_gew&)}})
        '
      CASE laufwerk_c_plus&
        '
        entfaerbe(suche_adr%,laufwerk_c_plus&)
        FOR m&=2 TO 25
          IF BTST(laufwerksliste%,m&)
            selektiere(suche_adr%,laufwerk_a&+m&)
          ENDIF
        NEXT m&
        '
      CASE leven&
        '
        dateiname$=CHAR{{OB_SPEC(suche_adr%,dateiname&)}}
        ' Dialogbox fr aktuellen Pfad
        ~OBJC_DRAW(aktuell_adr%,0,8,xx&,yy&,bb&,hh&)
        stoppen!=FALSE
        leven!=TRUE
        CLR dateizaehler&
        '
        baue_muster
        levenmuster$=muster$
        muster$="????????.???"
        durchsuche_alle_laufwerke
        '
        FOR m&=0 TO dateizaehler&-1
          CHAR{OB_SPEC(liste_adr%,liste_datei1&+m&)}=passende_datei$(m&)
          CHAR{OB_SPEC(liste_adr%,liste_distanz1&+m&)}=STR$(kleinstes_gewicht&(m&),5)
        NEXT m&
        ~OBJC_DRAW(liste_adr%,0,8,xx&,yy&,bb&,hh&)
        r_obj1%=FORM_DO(liste_adr%,0)
        entfaerbe(liste_adr%,r_obj1%)
        '
      CASE start&,loeschen&
        '
        ' Text aus Dialogbox holen
        dateiname$=CHAR{{OB_SPEC(suche_adr%,dateiname&)}}
        IF dateiname$=""
          r_obj&=abbruch&
        ELSE
          '
          IF r_obj&=loeschen&
            CHAR{OB_SPEC(gefunden_adr%,weiter&)}="L”schen"
            OB_FLAGS(gefunden_adr%,uebergehen&)=BCLR(OB_FLAGS(gefunden_adr%,uebergehen&),7)
          ELSE
            CHAR{OB_SPEC(gefunden_adr%,weiter&)}="Weiter"
            OB_FLAGS(gefunden_adr%,uebergehen&)=BSET(OB_FLAGS(gefunden_adr%,uebergehen&),7)
          ENDIF
          '
          ' Dialogbox fr aktuellen Pfad
          ~OBJC_DRAW(aktuell_adr%,0,8,xx&,yy&,bb&,hh&)
          '
          leven!=FALSE
          stoppen!=BTST(OB_STATE(suche_adr%,nachfrage&),0)
          baue_muster
          '
          IF r_obj&=loeschen& AND muster$="????????.???"
            ~FORM_ALERT(1,"[3][Platte l”schen nicht m”glich.][Abbruch]")
          ELSE
            durchsuche_alle_laufwerke
            '
            IF NOT oeffnen!
              IF NOT gefunden!
                ~FORM_ALERT(1,"[3][Datei nicht gefunden.][Okay]")
              ELSE
                ~FORM_ALERT(1,"[1]["+STR$(anzahl&)+" Dateien mit|zusammen "+STR$(bytes%)+" Bytes|gefunden.][Gut]")
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDSELECT
    UNTIL r_obj&=abbruch& OR oeffnen!
    '
    ' Botschaft an Hauptprogramm zur Bildschirmrestaurierung schicken
    ~FORM_DIAL(3,0,0,0,0,xx&,yy&,bb&,hh&)
    '
    ' Mens drfen wieder klappen
    ~WIND_UPDATE(0)
    ~MFREE(dta%)
  ENDIF
RETURN
' *
' * Alle angew„hlten Laufwerke durchsuchen
' *
PROCEDURE durchsuche_alle_laufwerke
  gefunden!=FALSE
  weiter!=TRUE
  CLR bytes%,anzahl&
  '
  ' Alle gewnschten Laufwerke durchsuchen
  FOR m&=0 TO 25
    IF BTST(OB_STATE(suche_adr%,laufwerk_a&+m&),0)
      suche_datei(CHR$(m&+65)+":\",dta%)
    ENDIF
    EXIT IF weiter!=FALSE
  NEXT m&
RETURN
' *
' * Muster erstellen
' *
PROCEDURE baue_muster
  ' Suchmuster erstellen
  muster$="        .   "
  MID$(muster$,1)=LEFT$(dateiname$,8)+"."+MID$(dateiname$,9)
  CHAR{erw%}=FN entferne_leer$(muster$)            !fr GEMINI
  m&=1
  WHILE m&<9
    IF MID$(muster$,m&,1)="*"
      FOR m&=m& TO 8
        MID$(muster$,m&,1)="?"
      NEXT m&
    ENDIF
    INC m&
  WEND
  m&=9
  WHILE m&<13
    IF MID$(muster$,m&,1)="*"
      FOR m&=m& TO 12
        MID$(muster$,m&,1)="?"
      NEXT m&
    ENDIF
    INC m&
  WEND
  '
  muster$=FN entferne_leer$(muster$)
RETURN
' *
' * Rekursive Suche durch den Dateien- und Ordnerbaum
' *
PROCEDURE suche_datei(pfad$,dta%)
  ~FSETDTA(dta%)
  '
  ' Aktuellen Pfad anzeigen
  CHAR{{OB_SPEC(aktuell_adr%,aktueller_pfad&)}}=LEFT$(pfad$,60)
  ~OBJC_DRAW(aktuell_adr%,aktueller_pfad&,0,xx&,yy&,bb&,hh&)
  '
  IF weiter!
    fehler&=FSFIRST(pfad$+muster$,-1)     !Datei/Ordner-Suche
    WHILE fehler&=0                       !Datei gefunden?
      IF BCLR(BYTE{dta%+21},5)=0          !normale Datei (Archivbit ausmaskieren)
        datei$=CHAR{dta%+30}              !Dateiname
        '
        ADD bytes%,{dta%+26}
        INC anzahl&
        '
        IF stoppen!
          ' Gefundenen Dateinamen zeigen
          CHAR{OB_SPEC(gefunden_adr%,pfad1&)}=LEFT$(pfad$+datei$,60)
          CHAR{OB_SPEC(gefunden_adr%,pfad2&)}=MID$(pfad$+datei$,61)
          CHAR{OB_SPEC(gefunden_adr%,bytes&)}=STR$({dta%+26})
          ~OBJC_DRAW(gefunden_adr%,0,8,xx&,yy&,bb&,hh&)
          r_obj1%=FORM_DO(gefunden_adr%,0)   !Weiter suchen oder Schluá?
          entfaerbe(gefunden_adr%,r_obj1%)
          SELECT r_obj1%
          CASE weiter&
            IF r_obj&=loeschen&
              KILL pfad$+datei$
            ENDIF
          CASE schluss&
            weiter!=FALSE
          CASE oeffne&
            CHAR{pfad%}=pfad$
            oeffnen!=TRUE
            weiter!=FALSE
          ENDSELECT
          ~OBJC_DRAW(aktuell_adr%,0,8,xx&,yy&,bb&,hh&)      !Box fr aktuellen Pfad
          '
        ELSE IF leven!
          IF dateizaehler&=0
            passende_datei$(0)=datei$
            kleinstes_gewicht&(0)=FN wld(datei$)
            dateizaehler&=1
          ELSE
            gewicht&=FN wld(datei$)
            FOR j&=0 TO dateizaehler&-1
              IF gewicht&<kleinstes_gewicht&(j&)
                INSERT kleinstes_gewicht&(j&)=gewicht&
                INSERT passende_datei$(j&)=datei$
                dateizaehler&=MIN(dateizaehler&+1,10)
                j&=20
              ENDIF
            NEXT j&
          ENDIF
        ENDIF
        gefunden!=TRUE
      ENDIF
      EXIT IF NOT weiter!
      fehler&=FSNEXT()
    WEND
    '
    IF weiter!
      fehler&=FSFIRST(pfad$+"*.*",16)               !Ordnersuche
      WHILE fehler&=0                               !Haben wir (noch) einen?
        IF BCLR(BYTE{dta%+21},5)=16                 !wirklich Ordner?
          datei$=CHAR{dta%+30}                      !Ordnername
          IF datei$<>"." AND datei$<>".."           !Dummies bleiben auáen vor
            suche_datei(pfad$+datei$+"\",dta%+46)   !Pfad verfolgen
          ENDIF
        ENDIF
        EXIT IF NOT weiter!
        ~FSETDTA(dta%)                              !DTA setzen
        fehler&=FSNEXT()                            !n„chster Ordner
      WEND
    ENDIF
  ENDIF
RETURN
'
' Objekt deselektieren und neu zeichnen
PROCEDURE entfaerbe(baum_adr%,objekt&)
  ~OBJC_CHANGE(baum_adr%,objekt&,0,xx&,yy&,bb&,hh&,BCLR(OB_STATE(baum_adr%,objekt&),0),1)
RETURN
' Objekt selektieren und neu zeichnen
PROCEDURE selektiere(baum_adr%,objekt&)
  ~OBJC_CHANGE(baum_adr%,objekt&,0,xx&,yy&,bb&,hh&,BSET(OB_STATE(baum_adr%,objekt&),0),1)
RETURN
' Objekt zeigen
PROCEDURE show(baum_adr%,objekt&)
  OB_FLAGS(baum_adr%,objekt&)=BCLR(OB_FLAGS(baum_adr%,objekt&),7)
RETURN
' Objekt verstecken
PROCEDURE verstecke(baum_adr%,objekt&)
  OB_FLAGS(baum_adr%,objekt&)=BSET(OB_FLAGS(baum_adr%,objekt&),7)
RETURN
' *
' * Leerstellen aus String entfernen
' *
FUNCTION entferne_leer$(el_name$)
  LOCAL m&,p&
  '
  IF INSTR(el_name$," ")>0
    p&=1
    FOR m&=1 TO LEN(el_name$)
      IF MID$(el_name$,m&,1)<>" "
        MID$(el_name$,p&,1)=MID$(el_name$,m&,1)
        INC p&
      ENDIF
    NEXT m&
    RETURN LEFT$(el_name$,PRED(p&))
  ELSE IF INSTR(el_name$,CHR$(0))>0
    RETURN LEFT$(el_name$,PRED(INSTR(el_name$,CHR$(0))))
  ELSE
    RETURN el_name$
  ENDIF
ENDFUNC
' *
' * Koordinaten in INLINE-Ressource berechnen
' *
PROCEDURE setze_koordinaten(adr%,rsc%)
  LOCAL nummer&,adresse%
  '
  nummer&=0
  REPEAT
    ~RSRC_OBFIX(adr%,nummer&)
    SELECT OB_TYPE(adr%,nummer&)
    CASE 21,22,29,30,31
      OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
      adresse%=OB_SPEC(adr%,nummer&)
      {adresse%}={adresse%}+rsc%
      {adresse%+4}={adresse%+4}+rsc%
      {adresse%+8}={adresse%+8}+rsc%
    CASE 23,24     !BITBLK,USERDEF
      OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
      adresse%=OB_SPEC(adr%,nummer&)
      {adresse%}={adresse%}+rsc%
    CASE 26,28,32
      OB_SPEC(adr%,nummer&)=OB_SPEC(adr%,nummer&)+rsc%
    ENDSELECT
    '
    INC nummer&
  UNTIL BTST(OB_FLAGS(adr%,nummer&-1),5)
RETURN
' *
' * Berechnung der Levenshteindistanz
' *
FUNCTION wld(datei$)
  $F%
  LOCAL i&,j&
  '
  d&(0,0)=0
  FOR j&=1 TO 12
    d&(0,j&)=d&(0,PRED(j&))+einfuegegewicht&
  NEXT j&
  '
  FOR i&=1 TO 12
    d&(i&,0)=d&(PRED(i&),0)+entfernegewicht&
  NEXT i&
  '
  FOR i&=1 TO LEN(datei$)
    FOR j&=1 TO LEN(levenmuster$)
      IF MID$(levenmuster$,j&,1)="?"
        d&(i&,j&)=MIN(MIN(d&(i&-1,j&-1)+jokergewicht&,d&(i&,j&-1)+einfuegegewicht&),d&(i&-1,j&)+entfernegewicht&)
      ELSE IF MID$(datei$,i&,1)=MID$(levenmuster$,j&,1)
        d&(i&,j&)=MIN(MIN(d&(i&-1,j&-1),d&(i&,j&-1)+einfuegegewicht&),d&(i&-1,j&)+entfernegewicht&)
      ELSE
        d&(i&,j&)=MIN(MIN(d&(i&-1,j&-1)+ersetzegewicht&,d&(i&,j&-1)+einfuegegewicht&),d&(i&-1,j&)+entfernegewicht&)
      ENDIF
    NEXT j&
  NEXT i&
  '
  RETURN d&(LEN(datei$),LEN(levenmuster$))
ENDFUNC
