'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=� , ß=á ,§=õ , ©=¸, °=ø
'kompilieren mit fbc -s gui FileAttibutes.Bas
'Tested with FB 0.17f using FBIde 0.4.6"
'©2006 by ytwinky, MD
'it's much easier with FB0.23.0
Const fbOkOnly = 0            'Nur die Schaltfläche OK anzeigen
Const fbOkCancel = 1          'Schaltflächen OK und Abbrechen anzeigen
Const fbAbortRetryIgnore = 2  'Abbruch, Wiederholen und Ignorieren
Const fbYesNoCancel = 3       'Ja, Nein und Abbrechen
Const fbYesNo = 4             'Schaltflächen Ja und Nein
Const fbRetryCancel = 5       'Schaltflächen Wiederholen und Abbrechen

Const fbCritical = 16         'Stop-Symbol
Const fbQuestion = 32         'Fragezeichen-Symbol
Const fbExclamation = 48      'Ausrufezeichen-Symbol
Const fbInformation = 64      'Information-Symbol

Const fbOK=1                  'Rückgabewert OK
Const fbCancel=2              'Rückgabewert Abbrechen
Const fbAbort=3               'Rückgabewert Abbruch
Const fbRepeat=4              'Rückgabewert Wiederholen
Const fbIgnore=5              'Rückgabewert Ignorieren
Const fbYes=6                 'Rückgabewert Ja
Const fbNo=7                  'Rückgabewert Nein
Const fbNull=0
Declare Function MsgBox Lib "user32" Alias "MessageBoxA" _
	(ByVal hWnd As Integer, ByVal lpText As String, _
	ByVal lpCaption As String, ByVal wType As Integer) As Integer
Const FILE_ATTRIBUTE_READONLY=&H1
Const FILE_ATTRIBUTE_HIDDEN=&H2
Const FILE_ATTRIBUTE_SYSTEM=&H4
Const FILE_ATTRIBUTE_DIRECTORY=&H10
Const FILE_ATTRIBUTE_ARCHIVE=&H20
Const FILE_ATTRIBUTE_NORMAL=&H80
Const FILE_ATTRIBUTE_COMPRESSED=&H800
Declare Function GetFAttr Lib "kernel32.dll" Alias "GetFileAttributesA" _
   (ByVal lpFileName As String) As Integer
Declare Function SetFileAttribute Lib "kernel32.dll" Alias "SetFileAttributesA" _
   (ByVal lpFileName As String, ByVal dwFileAttributes As Integer) As Integer
Declare Function EvalAttr(Attr As Integer) As String

Sub SetFattr(ByRef DateiName As String, ByRef Attr As Integer)
  'It's no good idea to set bits higher than archive with a program,
  'because windows uses them for its own purposes, so they are faded out..
  SetFileAttribute DateiName, (GetFAttr(DateiName) And &HFF00)+(Attr And &H2F)
End Sub

Sub ChkBitAtr(ByVal FileName As String, ByVal Which As String, WhichBit As Integer, ByRef Attr As Integer)
  Select Case MsgBox(fbNull, Which &!"\nJa=Setze Bit\nNein=Lösche Bit\nAbbrechen=Nix Ändern", FileName &" " &EvalAttr(Attr), fbYesNoCancel+fbQuestion)
    Case fbYes: Attr=Attr+WhichBit*IIF((Attr And WhichBit)=0, 1, 0)
    Case fbNo: Attr=Attr-WhichBit*IIF((Attr And WhichBit)<>0, 1, 0)
    Case Else: 'leave Bit as it is..
  End Select
End Sub

Function EvalAttr(Attr As Integer) As String
  Dim b As String
  If Attr And FILE_ATTRIBUTE_READONLY Then b+=" R"
  If Attr And FILE_ATTRIBUTE_HIDDEN Then b+=" H"
  If Attr And FILE_ATTRIBUTE_SYSTEM Then b+=" S"
  If Attr And FILE_ATTRIBUTE_ARCHIVE Then b+=" A"
  If Attr And FILE_ATTRIBUTE_DIRECTORY Then b+=" D"
  If Attr And FILE_ATTRIBUTE_NORMAL Then b+=" N"
  If Attr And FILE_ATTRIBUTE_COMPRESSED Then b+=" C"
  Function=b
End Function

Var Attr=0, OldAttr=0, FileName=Environ("Tmp") &"\TestDir", s="Eintrag : " &FileName
Attr=GetFAttr(FileName)
OldAttr=Attr
If Attr>=0 Then
  s+=!"\nAttribut(alt):" & Hex(Attr)+EvalAttr(Attr) &!"\n"
  ChkBitAtr FileName, "Setze NurLesen-Bit?", FILE_ATTRIBUTE_READONLY, Attr
  ChkBitAtr FileName, "Setze Versteckt-Bit?", FILE_ATTRIBUTE_HIDDEN, Attr
  ChkBitAtr FileName, "Setze System-Bit?", FILE_ATTRIBUTE_SYSTEM, Attr
  ChkBitAtr FileName, "Setze Archiv-Bit?", FILE_ATTRIBUTE_ARCHIVE, Attr
  If OldAttr<>Attr Then
    SetFAttr FileName, Attr
    Attr=GetFAttr(FileName)
  End If
  s+=!"\nAttribut(neu):" &(Hex(Attr)) &EvalAttr(Attr)
Else
  s+=" nicht gefunden.. " &Attr
End If

MsgBox fbNull, s, "Admin-Info", fbExclamation
'GetKey 'is only needed if you don't compile with fbc -s gui FileAttribute.Bas
End