'�=� , �=� , �=� ; �=� , �=�, �=� , �=� ,�=� , �=�
'��2007 by ytwinky, MD
'Tested with FB 0.17f using FBIde 0.4.6
#include "windows.bi"
Declare Function GetDriveSpecs Lib "kernel32" Alias "GetDiskFreeSpaceA" (byVal DriveName As String, SecsPerClstr As Integer, BytesPerSec As Integer, FreeClusters As Integer, TotalClusters As Integer) As Integer
Const Esc=!"\27", Cr=!"\13", hell=8, Rot=4, cFG=7, cBG=0
Dim Shared As Integer x=0, y=0, Bits=0
Dim As Integer i, j, Typ, binLD
Dim As String Valid, Fol, FileName, Dn, m
Dim LwTyp(5) As ZString Ptr=>{@"Unknown", @"Missing", @"Drv2Spec", @"HardDisk", @"NetDrive", @"CD/DVD"}

Function WorkAround(DriveName As String) As Integer
  Dim As Integer SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters
  If Left(DriveName, 1)<"C" Then Return False
  If GetDriveSpecs(DriveName, SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters) Then
    Return Abs(TotalClusters*SectorsPerCluster*BytesPerSector/1024/1024>3) 'not even 2.88MB-Floppy(whoever uses them) -->USB
  Else
    Return 0
  End If
End Function

Sub PrintAt(byVal WoZe As Integer, byVal WoSp As Integer, byVal Was As String, byVal WieFG As Integer=-1, byVal WieBG As Integer=-1)
  Dim As Integer sp=Pos(0), ze=CsrLin
  If WieFG<0 Then WieFG=cFG
  If WieBG<0 Then WieBG=cBG
  Color WieFG, WieBG
  Locate WoZe, WoSp
  Print Was;
  Color cFG, cBG
  Locate ze, sp
End Sub

Function MenuChar(byVal s As String, byVal First As Integer=1, byVal nVG As Integer=Hell+Rot) As String
  If First<>1 Then ?Mid(s, 1, First-1);
  Color nVG, 0
  Print Chr(s[First-1]);
  Color 7, 0
  Return Mid(s, First+1)
End Function

Sub Help()
  PrintAt(1, 40, "Help", Hell+3)
  PrintAt(2, 40, "Nothing special:")
  Locate 3, 40:?MenuChar("Use the Menu-Keys to select", 9)
  Locate x, y
End Sub

Sub SaveAll(byVal FileName As String, byVal Contents As String)
  Dim As Integer FilePtr=FreeFile
  Open FileName For Binary As #FilePtr
    Put #FilePtr,, Contents
  Close #FilePtr
End Sub

Function FindFiles(byVal Folder As String, byRef i As Integer) As String
'Tnx to yetifoot for findfirst.bas
  Dim Plural(1) As String={"s", ""}
  Dim ffd As WIN32_FIND_DATA
  Dim Attr As Integer
  Dim As String s=""
  If Chr(Folder[0])<>"\" Then Folder+="\"
  Dim As HANDLE hFind=FindFirstFile(Folder &"*", @ffd)
  If hFind=INVALID_HANDLE_VALUE Then
    s+="Ooops, no success for " &Folder
  Else
    Do
      If ffd.cFileName<>"." And ffd.cFileName<>".." Then
        Attr=ffd.dwFileAttributes And 255
        s+=Hex(Attr) &"  " &Folder &ffd.cFileName &!"\n"
        If Attr And &H10 Then s+=FindFiles(Folder &ffd.cFileName, i)
        i+=1
      End If
    Loop While FindNextFile(hFind, @ffd)
    FindClose hFind
  End If
  Return s
End Function

Sub ToggleBit(byVal j As Integer, byVal Sel As String)
  Locate 2+j, 2
  Print Sel
  If Sel=" " Then Bits=BitReset(Bits, j) Else Bits=BitSet(Bits, j)
End Sub

Print "Filelist of drives Ver 0.0002 ;-))"
Print "Valid drives:"
binLD=GetLogicalDrives()
For i=0 To 25
  If (binLD And 2^i)<>0 Then
  	Dn=Chr(65+i)
	  Typ=GetDriveType(Dn+":")
	  If Typ<>1 Then
	    Print MenuChar("[ ] Drive "+Dn+": Type:", 11);
	    If Typ<>2 Then
	      Print *LwTyp(Typ)
	    Else
	      Print *IIF(WorkAround(Dn+":"), @"USBDrive", @"Floppy")
	    End If
	    Valid+=Dn
	  End If
	End If
Next
Valid+="*" &"?" &Cr+Esc
Print MenuChar("    All   *", 11) 'is NOW a toggle ;-))
Print !"    ?=Help(F1)\n    Enter=ListFiles\n    Esc=Quit\n    Select:";
x=CsrLin
Do
  Locate x, 12
  Do
    m=UCase(Inkey)
    j=Instr(Valid, m)
    If m=Chr(255, 59) Then Help()
  Loop Until j<>0
  Select Case Instr(Valid, m)
    Case 0
    Case Len(Valid): End 'Esc
    Case Len(Valid)-1: 'Cr
    Case Len(Valid)-2: Help() '?
    Case Len(Valid)-3: '*
      If Bits<>0 Then
        For j=1 To Len(Valid)-4
          ToggleBit(j, " ")
        Next
      Else
        For j=1 To Len(Valid)-4
          ToggleBit(j, "*")
        Next
      End If
    Case Else
      ToggleBit(j, Mid(" *", Bit(Bits, j)+2, 1))
    End Select
  If m=Esc Then End
Loop Until m=Cr
Print
Print "Files will be stored in Drive-*.Txt in"
Print "Foldername(";Environ("Tmp");"), Ctrl-C to Quit:";
Input Fol
If Fol="" Then Fol=Environ("Tmp")
If Chr(Fol[0])<>"\" Then Fol+="\"
If Bits=0 Then
  Print "Nothing to list.."
Else
  For i=1 To Len(Valid)-2
    If Bit(Bits, i) Then
    	FileName=Fol &"Drive-" &Chr(Valid[i-1]) &".Txt"
    	SaveAll(FileName, FindFiles(Chr(Valid[i-1])+":", j))
    	Print FileName
    End If
  Next
End If
Print "Eniki..";
Sleep
End
'all lines following this one are not needed..