ChkDskGui (PureBasic)

;  тест ChkDskGui
;IncludeFile "RUSCOD.PBI"
Declare.s OemA2Ansi(Str$)
Declare ComboListDrive(List Drive.s())
Declare GetDrives(List Drive.s())
Declare HelpChkdsk()
Declare RunProg(*Value)
Declare.s FormatStr(Sring$)
Declare.s FormatStrFS(Sring$)
Declare.s FormatSizeDisk(Num.q)
Declare.s GetComString()
Declare.s DriveGetNumber(Sring$)
Define.s strexe
NewList Drive.s()
If OpenWindow(0, 100, 200, 440, 130, "ChkDskGui", #PB_Window_MinimizeGadget)
    ComboBoxGadget(0, 20, 16, 400, 25, #PB_ComboBox_Image) ; Создаёт раскрывающийся список
    GetDrives(Drive())
    ComboListDrive(Drive()) ; Получение списка дисков FIXED REMOVABLE
    i=1
    Handle = GetModuleHandle_(0)
    ForEach Drive.s()
      Text.s= Drive.s()
      Letter.s =LSet(Text,1)+":"
      hIco=ExtractAssociatedIcon_(Handle, @Letter, @i)
      AddGadgetItem(0, -1, Drive.s(), hIco)
    Next
    SetGadgetState(0, 0) ; Выбирает первый элемент списка
    If LoadFont(0,"Courier New",9)
        SetGadgetFont(0, FontID(0))  ; Установить загруженный шрифт Courier 10 как новый стандарт
    EndIf
    CheckBoxGadget(1, 20, 45, 280, 20, "\F - Исправление ошибок на диске") : SetGadgetState(1, #PB_Checkbox_Checked)
    CheckBoxGadget(2, 20, 65, 280, 20, "\R - Восстановление поврежденных секторов")
    CheckBoxGadget(3, 20, 85, 280, 20, "\X - Принудительное отключение тома") : SetGadgetState(3, #PB_Checkbox_Checked)
    ;   StringGadget(4,  20, 110, 420, 17, "")
    TextGadget(4,  20, 110, 420, 17, "тест дисков")
;   ButtonGadget(5, 300, 77, 27, 32, "?", #PB_Button_Default) ; не работает Default, не нажимается по Enter
    ButtonGadget(5, 300, 77, 27, 32, "?")
    ButtonGadget(6, 330, 77, 90, 32, "Старт")
;   GadgetToolTip(1,"подсказка")
;   SetActiveGadget(5) ; не работает Active, не нажимается по Enter
    SetGadgetText(4, GetComString())
    SetGadgetState(6, 0)
;     While #True
;   Select WaitWindowEvent()
;     Case #PB_Event_CloseWindow
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_Gadget
      Select EventGadget()
        Case 5 ; ?
            HelpChkdsk()
        Case 6 ; Старт
;           DisableGadget(5, 1) ; это работает не в порядке очереди, поэтому скрываем
            HideGadget(5, 1)
            HideGadget(6, 1) ; даёт невозможность поставить в очередь клики
;           Delay(3000)
;           MessageRequester("Тест",  "/c (Title Check Disk & @Echo off & Color 1e & cls & " + GetComString() + " & set /p Ok=^>^>)", 0)
            CreateThread(@RunProg(), 1)
;           DisableGadget(5, 0)
            HideGadget(5, 0)
            HideGadget(6, 0)
        Case 0
          SetGadgetText(4, GetComString())
        Case 1
            If GetGadgetState(1) = #PB_Checkbox_Unchecked
                SetGadgetState(2, #PB_Checkbox_Unchecked)
                SetGadgetState(3, #PB_Checkbox_Unchecked)
            EndIf
            SetGadgetText(4, GetComString())
        Case 2
            SetGadgetState(1, #PB_Checkbox_Checked)
            SetGadgetText(4, GetComString())
        Case 3
            If GetGadgetState(3) = #PB_Checkbox_Checked
                SetGadgetState(1, #PB_Checkbox_Checked)
            EndIf
            SetGadgetText(4, GetComString())
        EndSelect
      ElseIf Event = #PB_Event_CloseWindow And GetActiveWindow()=1
        HideWindow(1,0)
    EndIf
  Until Event = #PB_Event_CloseWindow And GetActiveWindow()=0
EndIf
End
Procedure RunProg(*Value)
    RunProgram("cmd.exe", "/c (Title Check Disk & @Echo off & Color 1e & cls & " + GetComString() + " & set /p Ok=^>^>)", "")
EndProcedure
Procedure.s GetComString()
    Define.s ComStr
    ComStr = "chkdsk.exe "
    ComStr + RSet(GetGadgetText(0), 1) + ":"
    If GetGadgetState(1)
        ComStr + " /F"
    EndIf
    If GetGadgetState(2)
        ComStr + " /R"
    EndIf
    If GetGadgetState(3)
        ComStr + " /X"
    EndIf
    ProcedureReturn ComStr
EndProcedure
Procedure.s OemA2Ansi(Str$)
  user32_dll=OpenLibrary(#PB_Any, "user32.dll")
  CallFunction(user32_dll,"OemToCharA",@Str$,@Str$)
  CloseLibrary(user32_dll)
  ProcedureReturn PeekS(@Str$,-1,#PB_Ascii)
EndProcedure
Procedure HelpChkdsk()
    Prog = RunProgram("chkdsk.exe", "/?", "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
    Output$ = ""
    If Prog
      While ProgramRunning(Prog)
        If AvailableProgramOutput(Prog)
          Output$ + Output$ + ReadProgramString(Prog,#PB_Unicode)
        EndIf
      Wend
      CloseProgram(Prog) ; Close the connection to the program
    EndIf
;   Output$ = RUSCOD(Output$, #DosToWin)
    Output$=OemA2Ansi(Output$)
    ;Output$=ReplaceString(Output$, #CR$ + "                     ", "") ; чтобы на экран умещалось
;   If CreateRegularExpression(0, "\A\s+") ; не удалил пустые строки в начале, только добавил 60 кб к EXE
;   If CreateRegularExpression(0, "\s+\z")
;       Output$ = ReplaceRegularExpression(0, Output$, "")
;   EndIf
;     If OpenWindow(1, 100, 200, 440, 130, "Справка", #PB_Window_MinimizeGadget | #PB_Window_WindowCentered)
;       EndIf
    MessageRequester("Справка", Output$)
EndProcedure
; Получить буквы дисков
Procedure GetDrives(List Drive.s())
    Define.i drives_avail
    drives_avail = GetLogicalDrives_()
    For i = 0 To 31
      If ((drives_avail >> i) & 1)
        AddElement(Drive())
        Drive() = Chr(i + 65)+":"
      EndIf
    Next
  EndProcedure
;Получение номера диска и раздела, из буквы раздела
Procedure.s DriveGetNumber(DriveLetter$)
  Protected DriveInfo.STORAGE_DEVICE_NUMBER, Ret$="",  hDevice = CreateFile_("\\.\" + DriveLetter$, 0, 0, 0, #OPEN_EXISTING, #FILE_ATTRIBUTE_NORMAL, #NUL)
  If hDevice
    If DeviceIoControl_(hDevice,#IOCTL_STORAGE_GET_DEVICE_NUMBER, 0, 0, DriveInfo, SizeOf(STORAGE_DEVICE_NUMBER), #NUL,  #NUL)
      Ret$=Str(DriveInfo\DeviceNumber) + ":" + Str(DriveInfo\PartitionNumber)
    EndIf
    CloseHandle_(hDevice)
  EndIf
  ProcedureReturn Ret$
EndProcedure
Procedure ComboListDrive(List Drive.s())
    Define.l Serial, type, i
    Define.s Lfwrk, FileSystem, VolName
    Define.q total_bytes
    ForEach Drive.s()
        Lfwrk=Drive.s()+"\"
        type =GetDriveType_(Lfwrk)
        FileSystem = Space(256)
        VolName= Space(256)
        GetVolumeInformation_(@Lfwrk, @VolName, 255, @Serial, 0, 0, @FileSystem, 255)
        Select type
            Case 2
                Drive()+" ["+DriveGetNumber(Drive()) + "] REM    "
            Case 3
                Drive()+" ["+DriveGetNumber(Drive())+"] FIXED  "
            Default
                DeleteElement(Drive())
                Continue
        EndSelect
        Drive() +FormatStr(VolName)+"  "+FormatStrFS(FileSystem)
        If (GetDiskFreeSpaceEx_(Lfwrk, 0, @total_bytes, 0))
            Drive() + Space(2) + FormatSizeDisk(total_bytes)
        EndIf
    Next
EndProcedure
; форматирует число в формат "0,5 Гб", "500 Гб"
Procedure.s FormatSizeDisk(Num.q)
    Define.s snum
    Define.f total_gb
    snum = StrF(Num/1024)
    total_gb = ValF(snum)
    total_gb = total_gb/1048576
    snum =StrF(total_gb,3)
    snum =RSet(snum, 7) + " Гб"
;   Debug Len(snum)
    ProcedureReturn snum
  EndProcedure
Procedure.s FormatStr(Sring$)
    Define.l LenSring
    LenSring = Len(Sring$)
    If LenSring >15
        Sring$ = LSet(Sring$,12) + "..."
    ElseIf LenSring < 15
        Sring$ = LSet(Sring$,15)
    EndIf
    ProcedureReturn Sring$
EndProcedure
Procedure.s FormatStrFS(Sring$)
    Define.l LenSring
    LenSring = Len(Sring$)
    If LenSring < 5
        Sring$ = LSet(Sring$,5)
    EndIf
    ProcedureReturn Sring$
EndProcedure