powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Получить в переменную результат Shell "regsvr32..
9 сообщений из 9, страница 1 из 1
Получить в переменную результат Shell "regsvr32..
    #38849630
Namik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Доброго Вам времени суток
Уважаемые господа.
С наступившим Вас Новым Годом.
Долгих лет Вам жизни, здоровья и успехов делах.

При наличии Вашего времени прошу Вас подсказать.

Данный код позволяет автоматически зарегистрировать список dll в List1.

Код: vbnet
1.
2.
3.
4.
For i = 0 To List1.ListCount - 1
List1.ListIndex = i
Shell "regsvr32  " + App.Path + "/" + List1.Text, vbNormalFocus
Next



При регистрации dll выходит диалоговое окно об успешном или не успешном выполнении регистрации.

Добавив к строке ключ /s

Код: vbnet
1.
Shell "regsvr32  /s" + App.Path + "/" + List1.Text, vbNormalFocus



Диалоговое окно не появляется.


Как сделать так чтобы сообщение о регистрации dll (успешном, не успешном ) попадало в переменную для последующей обработки.

Т.е.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
For i = 0 To List1.ListCount - 1
List1.ListIndex = i
Shell "regsvr32  " + App.Path + "/" + List1.Text, vbNormalFocus

Если файл зарегистрировался Тогда
переменная="Ok"
Нет
переменная="No ok"
Конец Если

Next



С Уважением и Благодарностью
Намик
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849665
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Namik,

Код: vbnet
1.
2.
Dim hRetVal
hRetVal = Shell("regsvr32  " + App.Path + "/" + List1.Text, vbNormalFocus)


и затем проверяйте значение hRetVal.
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849674
Namik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
The_Prist Благодарю Вас за ответ.

Я попробовал проверить значения которые получает hRetVal через
Код: vbnet
1.
debug.print hRetVal

.

На выходе получил следующие значения:
4028 - значение dll прошедшего регистрацию успешно
4000 - значение dll прошедшего регистрацию успешно
3492 - значение dll не прошедшего регистрацию успешно

Правильно ли я понимаю что ошибка в регистрации = 3492 и это значение верно для всех ошибок регистрации ?

Или hRetVal нужно проверять как то по другому?

С Уважением и Благодарностью
Намик
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849703
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Namik,

попробуйте на двух разных библиотеках, которые невозможно зарегистрировать. Вообще должно возвращаться значение ошибки одно для всех. Но лучше проверить(я давно не использовал подобный метод и не могу поэтому сказать с уверенностью).
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849706
Namik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
The_Prist проверил.

На втором ошибочном файле в качестве ошибки выдаёт 508,
а вот на том файле который выдавал в качестве ошибки 3492, при повторной попытке регистрации уже выдал другое значение - 3204.

Значения успешных результатов также меняются.

С Уважением и Благодарностью
Намик
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849712
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я так думаю, это не код ошибки, а какой-то идентификатор, поэтому он все время разный

сам использую такой код:
Код: vbnet
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.
Public Declare Function DLLSelfRegister Lib "vb6stkit.dll" (ByVal lpDllName As String) As Integer

Public Function DLLReg(Path As String, FileName As String) As String

Dim intDllSelfRegRet As Integer
Const FAIL_OLE = 2
Const FAIL_LOAD = 3
Const FAIL_ENTRY = 4
Const FAIL_REG = 5

ChDrive Path
ChDir Path
DLLReg = ""

On Error Resume Next
intDllSelfRegRet = DLLSelfRegister(Path + FileName)
If (Err <> 49) And (Err <> 0) Then
    DLLReg = "COMMON_CANTREGUNEXPECTED"
Else
    Select Case intDllSelfRegRet
        Case 0
            DLLReg = ""
        Case FAIL_OLE
            DLLReg = "COMMON_CANTREGOLE"
        Case FAIL_LOAD
            DLLReg = "COMMON_CANTREGLOAD"
        Case FAIL_ENTRY
            DLLReg = "COMMON_CANTREGENTRY"
        Case FAIL_REG
            DLLReg = "COMMON_CANTREGREG"
        Case Else
            DLLReg = "COMMON_CANTREGUNEXPECTED"
    End Select
End If
On Error GoTo 0

End Function

но для него нужна, понятно, vb6stkit.dll

можно попробовать поэкспериментировать с ShellExecute вместо Shell
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849715
Namik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Приветствую Вас Shocker.Pro.

Попробуем Ваш код.

С Уважением и Благодарностью
Намик
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38849745
The trick
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
http://www.cyberforum.ru/post6447691.html
Вообще получить статус можно через GetExitCodeProcess
http://www.cyberforum.ru/post6454544.html
...
Рейтинг: 0 / 0
Получить в переменную результат Shell "regsvr32..
    #38850092
Namik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
The_Prist, Shocker.Pro, The trick Большое Вам спасибо.

Всё работает.
Вот код - может кому понадобиться.

Код: vbnet
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.
Option Explicit
Dim hLib As String
Dim i As Integer
Dim dllz As String
Public fso As New FileSystemObject
Public file1 As File

Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As Long
    lpFile As Long
    lpParameters As Long
    lpDirectory As Long
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As Long
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
   
End Type
 
Private Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExW" (lpExecInfo As SHELLEXECUTEINFO) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Const SEE_MASK_NOCLOSEPROCESS   As Long = &H40
Private Const SW_SHOWDEFAULT            As Long = 10
Private Const INFINITE                  As Long = -1&
 
Private Sub Command1_Click()

    Dim sh  As SHELLEXECUTEINFO
    Dim ret As Long
    
    sh.cbSize = Len(sh)
    sh.fMask = SEE_MASK_NOCLOSEPROCESS
    sh.lpFile = StrPtr("regsvr32.exe")
    
For i = 0 To List1.ListCount - 1

List1.ListIndex = i
List1.ListIndex = i
ChDir App.Path
dllz = List1.Text
sh.lpParameters = StrPtr("/s  " & dllz & "")

sh.nShow = SW_SHOWDEFAULT
    
    If ShellExecuteEx(sh) Then
    
        WaitForSingleObject sh.hProcess, INFINITE
    
        GetExitCodeProcess sh.hProcess, ret
        
        CloseHandle sh.hProcess
        
    
        If ret Then
        Debug.Print "1"
        Else
        Debug.Print "2"
          End If
        
    End If
    
   Next

End Sub

Private Sub Form_Load()

For Each file1 In fso.GetFolder(App.Path).Files
If fso.GetExtensionName(file1.Path) = "dll" Or fso.GetExtensionName(file1.Path) = "ocx" Then
List1.AddItem file1.Name
End If
Next file1

End Sub



С Уважением и Благодарностью
Намик
...
Рейтинг: 0 / 0
9 сообщений из 9, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Получить в переменную результат Shell "regsvr32..
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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