/code/ Показать список всех дисков

Раздел посвящен программированию с использованием Power Basic.
DarkMachine
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 51
Зарегистрирован: 24.02.2012 (Пт) 15:58

/code/ Показать список всех дисков

Сообщение DarkMachine » 06.03.2012 (Вт) 15:50

Показывает диски, сетевые соединения, накопители и т.д.
а именно: Метка тома, Буква, Тип и Размер. Размер выводится с префиксом, для удобства чтения.

Код: Выделить всё
#COMPILE EXE
#DIM ALL

#INCLUDE ONCE "win32api.inc"
#INCLUDE "shell32.inc"

%SZ_KILOBYTES = 1000&&
%SZ_MEGABYTES = %SZ_KILOBYTES * 1000&&
%SZ_GIGABYTES = %SZ_MEGABYTES * 1000&&
%SZ_TERABYTES = %SZ_GIGABYTES * 1000&&
%SZ_PETABYTES = %SZ_TERABYTES * 1000&&

FUNCTION SizePrefix ( BYVAL sz AS QUAD) AS STRING
    LOCAL rz AS STRING
    IF sz >=0 AND sz < %SZ_KILOBYTES THEN
       rz = STR$(sz) & " Bytes"
    ELSEIF sz >= %SZ_KILOBYTES AND sz < %SZ_MEGABYTES THEN
       rz = STR$(sz \ %SZ_KILOBYTES) & " KB"
    ELSEIF sz >= %SZ_MEGABYTES AND sz < %SZ_GIGABYTES THEN
       rz = STR$(sz \ %SZ_MEGABYTES) & " MB"
    ELSEIF sz >= %SZ_GIGABYTES AND sz < %SZ_TERABYTES THEN
       rz = STR$(sz \ %SZ_GIGABYTES) & " GB"
    ELSEIF sz >= %SZ_TERABYTES AND sz < %SZ_PETABYTES THEN
       rz = STR$(sz \ %SZ_TERABYTES) & " TB"
    ELSEIF sz >= %SZ_PETABYTES THEN
       rz = STR$(sz \ %SZ_PETABYTES) & " PT"
    END IF
    FUNCTION = rz
END FUNCTION

FUNCTION GetAllVolumes() AS STRING
    LOCAL objShell      AS IShellDispatch, _
          objFolder2    AS Folder, _
          objFolderItem AS FolderItem, _
          nFolder       AS LONG, _
          r             AS STRING, sLetter, sFolderType AS ASCIIZ * 256, _
          disksz        AS QUAD

    LET objShell = NEWCOM $PROGID_Shell32_Shell

    objFolder2 = objShell.NameSpace( %ShellSpecialFolderConstants.ssfDRIVES )

    IF ISOBJECT(objFolder2) THEN
        FOR nFolder = 0 TO objFolder2.Items.Count -1
            objFolderItem = objFolder2.Items.Item( nFolder )
            IF objFolderItem.IsFileSystem THEN
               sLetter     = objFolderItem.Path
               sFolderType = objFolderItem.type
               disksz      = DISKSIZE(sLetter)
               r += objFolderItem.Name & $TAB & sLetter & $TAB & _
                    sFolderType & $TAB & SizePrefix(disksz) & $CRLF
            END IF
        NEXT
    END IF
    FUNCTION = r
END FUNCTION

CALLBACK FUNCTION OutputWindowProc()
    LOCAL hWx, hWy AS LONG
    IF CB.MSG = %WM_SIZE THEN DIALOG GET CLIENT CBHNDL TO hWx, hWy:CONTROL SET SIZE CBHNDL, 100, hWx, hWy
    IF CB.MSG = %WM_COMMAND AND CB.CTL = %IDCANCEL THEN DIALOG END CB.HNDL
END FUNCTION

SUB ShowOutput (Caption$, Rez$)
    LOCAL hDlg, hFont1 AS LONG
    DIALOG NEW PIXELS, 0, Caption$, 10,10, 300, 400, %WS_POPUP OR _
        %WS_BORDER OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_CENTER OR %DS_SYSMODAL OR _
        %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT _
        OR %WS_EX_TOOLWINDOW OR %WS_EX_APPWINDOW OR %WS_EX_LEFT OR _
        %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg

    FONT NEW "Tahoma", 8, 1, %RUSSIAN_CHARSET TO hFont1
    CONTROL ADD TEXTBOX, hdlg, 100, Rez$, 1, 1, 300, 400, %ES_MULTILINE OR %ES_WANTRETURN OR %WS_HSCROLL OR %WS_VSCROLL
    CONTROL SET FONT     hDlg, 100, hFont1

    DIALOG SHOW MODAL hDlg, CALL OutputWindowProc()
END SUB

FUNCTION PBMAIN () AS LONG
    ShowOutput ( "List All Volumes", GetAllVolumes )
END FUNCTION

jangle
Википедик
Википедик
Аватара пользователя
 
Сообщения: 3013
Зарегистрирован: 03.06.2005 (Пт) 12:02
Откуда: Нидерланды

Re: /code/ Показать список всех дисков

Сообщение jangle » 06.03.2012 (Вт) 16:54

shell32.inc надо прикладывать к исходнику

DarkMachine
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 51
Зарегистрирован: 24.02.2012 (Пт) 15:58

Re: /code/ Показать список всех дисков

Сообщение DarkMachine » 06.03.2012 (Вт) 22:25

jangle писал(а):shell32.inc надо прикладывать к исходнику

Нет смысла, т.к. можно сгенерить СОМ Браузером.

Димитрий
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 194
Зарегистрирован: 26.01.2005 (Ср) 22:47
Откуда: Волгоград

Re: /code/ Показать список всех дисков

Сообщение Димитрий » 07.03.2012 (Ср) 12:14

можно сгенерить СОМ Браузером

Не знал об этой функции, спасибо за инфу. :)


Вернуться в Power Basic

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1

    TopList