XProfan

Source watts on the 15.07.2007 from the MMJ-Quellcodesammlung (Dietmar horn) in The Babyklappe on XProfan.Com stored:
File: Dateiattribute the Files one whole Verzeichnisses ändern
Program: ChgFilAtr. develops under Profan 6.6 and windows 95
setting or deletes The Dateiattribute all or ausgewählter Files one
Verzeichnisses. the Attribut the Verzeichnisses becomes not changed!
Unterverzeichnisse stay unchanged.
----------------------------------------------------------------------------------
Version 1.0  25.11.2001.     the Programmbeispiel can spare using go, for
Schäden can no Liability übernommen be.
Author: Gerhard Putschalka
email: g.putschalka@web.de
homepage: http://members.telering.at/g.putschalka/index.html
----------------------------------------------------------------------------------
Declare way$,amount%,Wert&,X%,_dlg%,end%,Abbr%,name$,Id#,Text#,BAlle%,Bal%,AlleKz%
Declare ROSet%,RORes%,RONoc%,HiSet%,HiRes%,HiNoc%,ArSet%,ArRes%,ArNoc%,BOk%,BAbbr%,Box%

Proc introduction  dial directory. way$ contains thereafter whom way To whom To

    bearbeitenden Files, SPfad$ is way to that actually Program.
    Declare Zx$,SPfad$,Anz%
    Let SPfad$=@$ GetDir(@)     secure actually way
    ClearList
    Let way$ = @$ ChooseDir(directory dial:)  Lfwk:Pf1Pf2
    Let Abbr% = 1

    If (@Len(way$) > 0)

        Let Abbr% = 0
        AddFiles *.*
        übertrage The Entries in a Multiselect Listbox, suppress any directories
        Let Anz% = 0
        Let Box% = control(LISTBOX,,$50B008C3,360,30,370,305,_dlg%,100,%HInstance)
        @createtext(_dlg%,Files to that Ändern select,440,10,220,16)

        WhileNot (Anz% > %GetCount)

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

        EndWhile

    EndIf

    Return

ENDPROC

dial any Listboxeinträge from

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%)    entry Mark
        Inc X%

    EndWhile

    Return

ENDPROC

Proc Execute_Änderungen

    Parameters FilNam$
    Assign #1,FilNam$
    AtrByt% = @GetFAttr(#1)                   read 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 the Dateiattribut
    Return

ENDPROC

verarbeite Listboxliste and ändere The Dateiattribute the selected Eonträge

Proc Attribute_ändern

    Declare AtrByt%,Y&,Anzahl&
    Dim Id#,1000     capacity 1000 reicht for 250 Files in the directory ggf. Change!
    Dim Text#,256
    Let X% = 0
    let Anzahl& = sendmessage(Box%,$0190,0,0)    amount the Selektierungen
    sendmessage(Box%,$0191,Anzahl&,ID#)          The selektierten Entries übernehmen

    WhileNot (X% = Anzahl&)

        let Y& = long(ID#,mul(X%,4))              number the Eintrages fetch
        sendmessage(Box%,$0189,Y&,Text#)          whom Sel. Text from the list fetch
        Let name$ = way$;@String $(Text#,0)
        Execute_Änderungen name$
        inc X%

    EndWhile

    Dispose Id#
    Dispose Text#
    Return

ENDPROC

Ändere The Dateiattribute of all Listboxeinträge (choices having no weight)

Proc Alle_ändern

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

    While (X% < Y%)

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

    EndWhile

    Return

ENDPROC

show Choose-Dialog to selection the Files
and to that to determine which attributes To ändern are

Proc Choose-Dialog

    @createtext(_dlg%,not ändern,498,374,90,20)  3428
    @createtext(_dlg%,delete,592,374,60,20)  3432
    @createtext(_dlg%,settle,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%,cache,408,426,104,16)  2676
    @createtext(_dlg%,archive,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%,Cancel,640,480,88,30)  3852
    let BAlle%=@createbutton(_dlg%,any Mark,500,325,120,30)  3852
    set any Radiobuttons on not ändern
    SetCheck RoNoc%,1
    SetCheck HiNoc%,1
    SetCheck ArNoc%,1
    blockiere OK Button if The Listbox 0 Entries contains
    Case (@GetCount(Box%)= 0) : EnableWindow Bok%,0
    Let end% = 0
    Let Abbr% = 0

    WhileNot end%

        If @GetFocus(Bok%)

            Let end% = 1

        ElseIf @GetFocus(BAbbr%)

            Let end% = 1
            Let Abbr% = 1

        ElseIf @GetFocus(BAl%)

            Let AlleKz% = 1
            Let end% = 1

        ElseIf @GetFocus(BAlle%)

            Wähle_alle
            @SetFocus(_dlg%)      prevented hängenbleiben the Button any select

        EndIf

    EndWhile

    Return

ENDPROC

========
MainLine
========
SetTrueColor 1
Window Style 16
Windowtitle Dateiattribute ändern
Window 0,0-800,600
CLS @RGB(255,255,255)
let _dlg%=@createdialog(%Hwnd,dialog,10,10,750,550)
introduction
Casenote Abbr% : Choose-Dialog

Ifnot Abbr%

    If AlleKz%

        Alle_ändern

    Else

        Attribute_ändern

    EndIf

EndIf

@DestroyWindow(_dlg%)
@MessageBox(Program watts exits,,32)
end