XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
File: Dateiattribute der File eines ganzen Verzeichnisses ändern
Programm: ChgFilAtr. Entwickelt unter Profan 6.6 und Windows 95
Setzt oder löscht die Dateiattribute aller oder ausgewählter File eines
Verzeichnisses. Das Attribut des Verzeichnisses wird nicht verändert!
Unterverzeichnisse bleiben unverändert.
----------------------------------------------------------------------------------
Version 1.0  25.11.2001.     Das Programmbeispiel kann frei benutzt werden, per
Schäden kann keine Haftung übernommen werden.
Autor: Gerhard Putschalka
email: g.putschalka@web.de
homepage: http://members.telering.at/g.putschalka/index.html
----------------------------------------------------------------------------------
Declare Pfad$,Anzahl%,Wert&,X%,_dlg%,Ende%,Abbr%,Name$,Id#,Text#,BAlle%,Bal%,AlleKz%
Declare ROSet%,RORes%,RONoc%,HiSet%,HiRes%,HiNoc%,ArSet%,ArRes%,ArNoc%,BOk%,BAbbr%,Box%

Proc Einleitung  wähle Verzeichnis. Pfad$ enthält danach den Pfad zu den zu

    bearbeitenden File, SPfad$ ist Pfad zum aktuellen Programm.
    Declare Zx$,SPfad$,Anz%
    Let SPfad$=@GetDir$(@)     sichere aktuellen Pfad
    ClearList
    Let Pfad$ = @ChooseDir$(Verzeichnis wählen:)  Lfwk:Pf1Pf2
    Let Abbr% = 1

    If (@Len(Pfad$) > 0)

        Let Abbr% = 0
        AddFiles *.*
        übertrage die Einträge in eine Multiselect Listbox, unterdrücke alle Verzeichnisse
        Let Anz% = 0
        Let Box% = control(LISTBOX,,$50B008C3,360,30,370,305,_dlg%,100,%HInstance)
        @createtext(_dlg%,File zum Ändern auswählen,440,10,220,16)

        WhileNot (Anz% > %GetCount)

            Let Zx$ = @ListBoxItem$(Anz%)
            CaseNot @Equ$(@Left$(Zx$,1),[) : @AddString(Box%,Zx$)
            Inc Anz%

        EndWhile

    EndIf

    Return

EndProc

wähle alle Listboxeinträge aus

Proc Wähle_alle

    Declare Y%
    Let X% = 0
    Let Y% = @GetCount(Box%)
    @MessageBox(@Str$(@GetCount(Box%)),,32)

    While (X% < Y%)

        sendmessage (Box%,$0185,1,X%)    Eintrag markieren
        Inc X%

    EndWhile

    Return

EndProc

Proc Execute_Änderungen

    Parameters FilNam$
    Assign #1,FilNam$
    AtrByt% = @GetFAttr(#1)                   lese Dateiattribut
    Case @GetCheck(ROSet%) : AtrByt% = @SetBit(AtrByt%,0,1)
    Case @GetCheck(RORes%) : AtrByt% = @SetBit(AtrByt%,0,0)
    Case @GetCheck(HiSet%) : AtrByt% = @SetBit(AtrByt%,1,1)
    Case @GetCheck(HiRes%) : AtrByt% = @SetBit(AtrByt%,1,0)
    Case @GetCheck(ArSet%) : AtrByt% = @SetBit(AtrByt%,5,1)
    Case @GetCheck(ArRes%) : AtrByt% = @SetBit(AtrByt%,5,0)
    SetFAttr #1,AtrByt%                       ändere das Dateiattribut
    Return

EndProc

verarbeite Listboxliste und ändere die Dateiattribute der ausgewählten Eonträge

Proc Attribute_ändern

    Declare AtrByt%,Y&,Anzahl&
    Dim Id#,1000     Kapazität 1000 reicht per 250 File im Verzeichnis ggf. ändern!
    Dim Text#,256
    Let X% = 0
    let Anzahl& = sendmessage(Box%,$0190,0,0)    Anzahl der Selektierungen
    sendmessage(Box%,$0191,Anzahl&,ID#)          Die selektierten Einträge übernehmen

    WhileNot (X% = Anzahl&)

        let Y& = long(ID#,mul(X%,4))              Nummer des Eintrages holen
        sendmessage(Box%,$0189,Y&,Text#)          den Sel. Text aus der Liste holen
        Let Name$ = Pfad$;@String$(Text#,0)
        Execute_Änderungen Name$
        inc X%

    EndWhile

    Dispose Id#
    Dispose Text#
    Return

EndProc

Ändere die Dateiattribute von allen Listboxeinträge (Auswahlen haben keine Bedeutung)

Proc Alle_ändern

    Declare Y%,AtrByt%
    Let X% = 0
    Let Y% = @GetCount(Box%)

    While (X% < Y%)

        Let Name$ = Pfad$;@GetString$(Box%,X%)
        Execute_Änderungen Name$
        Inc X%

    EndWhile

    Return

EndProc

zeige Auswahldialog zur Auswahl der File
und zum Bestimmen welche Attribute zu ändern sind

Proc Auswahldialog

    @createtext(_dlg%,nicht ändern,498,374,90,20)  3428
    @createtext(_dlg%,löschen,592,374,60,20)  3432
    @createtext(_dlg%,setzen,664,374,50,20)  3964
    let RONoc%=@createradiobutton(_dlg%,,536,396,16,16)  3044
    let RORes%=@createradiobutton(_dlg%,,606,396,16,16)  2332
    let ROSet%=@createradiobutton(_dlg%,,680,396,16,16)  2448
    @creategroupbox(_dlg%,,528,383,176,32)  2792
    let HiNoc%=@createradiobutton(_dlg%,,536,426,16,16)  2436
    let HiRes%=@createradiobutton(_dlg%,,606,426,16,16)  2776
    let HiSet%=@createradiobutton(_dlg%,,680,426,16,16)  2420
    @creategroupbox(_dlg%,,528,413,176,32)  2780
    let ArNoc%=@createradiobutton(_dlg%,,536,456,16,16)  2388
    let ArRes%=@createradiobutton(_dlg%,,606,456,16,16)  2804
    let ArSet%=@createradiobutton(_dlg%,,680,456,16,16)  2796
    @creategroupbox(_dlg%,,528,443,176,32)  2784
    @createtext(_dlg%,Schreibschutz,408,392,100,16)  3060
    @createtext(_dlg%,versteckt,408,426,104,16)  2676
    @createtext(_dlg%,Archiv,408,456,104,16)  2464
    let BOk%=@createbutton(_dlg%,markierte ändern,360,480,130,30)  3420
    let BAl%=@createbutton(_dlg%,ALLE ändern,500,480,130,30)  3420
    let BAbbr%=@createbutton(_dlg%,abbrechen,640,480,88,30)  3852
    let BAlle%=@createbutton(_dlg%,alle markieren,500,325,120,30)  3852
    setze alle Radiobuttons auf nicht ändern
    SetCheck RoNoc%,1
    SetCheck HiNoc%,1
    SetCheck ArNoc%,1
    blockiere OK Button wenn die Listbox 0 Einträge enthält
    Case (@GetCount(Box%)= 0) : EnableWindow Bok%,0
    Let Ende% = 0
    Let Abbr% = 0

    WhileNot Ende%

        If @GetFocus(Bok%)

            Let Ende% = 1

        ElseIf @GetFocus(BAbbr%)

            Let Ende% = 1
            Let Abbr% = 1

        ElseIf @GetFocus(BAl%)

            Let AlleKz% = 1
            Let Ende% = 1

        ElseIf @GetFocus(BAlle%)

            Wähle_alle
            @SetFocus(_dlg%)      verhindert hängenbleiben der Taste alle auswählen

        EndIf

    EndWhile

    Return

EndProc

========
MainLine
========
SetTrueColor 1
WindowStyle 16
Windowtitle Dateiattribute ändern
Window 0,0-800,600
CLS @RGB(255,255,255)
let _dlg%=@createdialog(%Hwnd,Dialog,10,10,750,550)
Einleitung
CaseNot Abbr% : Auswahldialog

IfNot Abbr%

    If AlleKz%

        Alle_ändern

    Else

        Attribute_ändern

    EndIf

EndIf

@DestroyWindow(_dlg%)
@MessageBox(Programm wurde beendet,,32)
end