Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите разобрать код / 10 сообщений из 10, страница 1 из 1
07.01.2008, 09:15
    #35046802
surbanec
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Нужно отделить мух от говна:
Вот Код
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
VB4  32 , VB5 
Level: Advanced 

В Win32 API есть парочка функций, позволяющих форматировать и копировать дискеты из программы: 

Private Declare Function SHFormatDrive _ 
        Lib "shell32" (ByVal hwnd As Long, _ 
        ByVal Drive As Long, _ 
        ByVal fmtID As Long, _ 
        ByVal options As Long) As Long 
Private Declare Function GetDriveType _ 
        Lib "kernel32" _ 
        Alias "GetDriveTypeA" _ 
        (ByVal nDrive As String) As Long 

Добавьте две command buttons в форму, назовите их cmdDiskCopy и cmdFormatDrive, и засуньте в их события Click следующие фрагменты кода: 

Private Sub cmdDiskCopy_Click() 
        ' DiskCopyRunDll требует два параметра - From и To 
        Dim DriveLetter$, DriveNumber&, _ 
                DriveType& 
        Dim RetVal&, RetFromMsg& 
        DriveLetter = UCase(Drive1.Drive) 
        DriveNumber = (Asc(DriveLetter) - _ 
                 65 ) 
        DriveType = GetDriveType_ 
                (DriveLetter) 
        If DriveType =  2  Then  'Floppies, _ 
                etc 
                RetVal = Shell_ 
                        ("rundll32.exe " & _ 
                        "diskcopy.dll," _ 
                        & "DiskCopyRunDll " & _ 
                        DriveNumber & "," & _ 
                        DriveNumber,  1 ) 
        Else   ' Just in case 
                RetFromMsg = MsgBox_ 
                        ("Only floppies can be " & _ 
                        "copied",  64 , _ 
                        "DiskCopy Example") 
        End If 
End Sub 

Private Sub cmdFormatDrive_Click() 
        Dim DriveLetter$, DriveNumber&, _ 
                DriveType& 
        Dim RetVal&, RetFromMsg% 
                DriveLetter = UCase(Drive1.Drive) 
        DriveNumber = (Asc(DriveLetter) - _ 
                 65 ) 
        ' Заменить букву на цифру: A=0 
        DriveType = GetDriveType_ 
                (DriveLetter) 
        If DriveType =  2  Then  _ 
                ' т.е. флоп 
                RetVal = SHFormatDrive(Me.hwnd, _ 
                        DriveNumber,  0 &,  0 &) 
        Else 
                RetFromMsg = MsgBox_ 
                        ("This drive is NOT a " & _ 
                        "removeable drive! " & _ 
                        "Format this drive?", _ 
                         276 , "SHFormatDrive Example") 
                If RetFromMsg =  6  Then 
                        ' Раскомментируйте и увидите... 
                        'RetVal = SHFormatDrive_ 
                                (Me.hwnd, _ 
                                '   DriveNumber, 0&, 0&) 
                End If 
        End If 
End Sub 

Добавьте контрол DriveListBox под именем Drive1: 

Private Sub Drive1_Change() 
        Dim DriveLetter$, DriveNumber&, _ 
                DriveType& 
        DriveLetter = UCase(Drive1.Drive) 
        DriveNumber = (Asc(DriveLetter) - _ 
                 65 ) 
        DriveType = GetDriveType_ 
                (DriveLetter) 
        If DriveType <>  2  Then  _ 
                'Floppies, etc 
                cmdDiskCopy.Enabled = False 
        Else 
                cmdDiskCopy.Enabled = True 
        End If 
End Sub 

Будьте осторожны: так недолго и винт запороть. 


Нужно выделить отсюда только форматирование
...
Рейтинг: 0 / 0
07.01.2008, 10:13
    #35046819
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Неужели текст "Private Sub cmdFormatDrive_Click()" ни о чем не говорит?
...
Рейтинг: 0 / 0
07.01.2008, 15:05
    #35047092
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Эй, ты же в предыдущем посте был недоволен, что пример в VB5 (кстати безосновательно, из приведенного кода этого никак не было видно!) Почему же сам приводишь пример, о котором говоришь как о VB5? Ты не считаешь, что другие также вот отреагируют? Это же код в VB5! Ну и назовут как ты назвал...
...
Рейтинг: 0 / 0
07.01.2008, 18:35
    #35047326
surbanec
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
AntonariyНеужели текст "Private Sub cmdFormatDrive_Click()" ни о чем не говорит?
Я только хочу узнать рабочий ли это код?
Из этого выделяется:


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Private Declare Function GetDriveType _
        Lib "kernel32" _
        Alias "GetDriveTypeA" _
        (ByVal nDrive As String) As Long
Private Sub Form_Load()

RetVal = SHFormatDrive(Me.hWnd,  2 ,  0 &,  0 &)



End Sub
Насколько эта функция рабочая?
...
Рейтинг: 0 / 0
07.01.2008, 18:40
    #35047330
surbanec
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Пардон ошибся
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
Private Declare Function SHFormatDrive _ 
        Lib "shell32" (ByVal hwnd As Long, _ 
        ByVal Drive As Long, _ 
        ByVal fmtID As Long, _ 
        ByVal options As Long) As Long 


Private Sub Form_Load()

RetVal = SHFormatDrive(Me.hWnd,  2 ,  0 &,  0 &)



End Sub
Насколько функция рабочая?
...
Рейтинг: 0 / 0
07.01.2008, 22:05
    #35047474
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Попробуй - узнаешь. У меня нет дисковода.
...
Рейтинг: 0 / 0
07.01.2008, 22:08
    #35047476
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
AntonariyПопробуй - узнаешь. У меня нет дисковода.отмааазки. Пойди в магазин, купи дисковод, подключи, проверь и сообщи ему.
...
Рейтинг: 0 / 0
08.01.2008, 11:13
    #35047820
Aklin
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
White Owl AntonariyПопробуй - узнаешь. У меня нет дисковода.отмааазки. Пойди в магазин, купи дисковод, подключи, проверь и сообщи ему.

легче виртуалку поставить, чем устаревшее Г на легаси фри ставить
...
Рейтинг: 0 / 0
08.01.2008, 17:21
    #35048389
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Aklin White Owl AntonariyПопробуй - узнаешь. У меня нет дисковода.отмааазки. Пойди в магазин, купи дисковод, подключи, проверь и сообщи ему.

легче виртуалку поставить, чем устаревшее Г на легаси фри ставитьА как же преодоление трудностей? Чтоб закалить дух надо заниматься не тем чем легче, а тем чем бессмысленней!
...
Рейтинг: 0 / 0
13.01.2008, 19:37
    #35058488
surbanec
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите разобрать код
Ну что этот код пройдёт через VB6??????
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите разобрать код / 10 сообщений из 10, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]