Ответить

' Pishi eto v module *************************************************************

Public Declare Function ShellExecute _

Lib "shell32.dll" Alias _

"ShellExecuteA" (ByVal hwnd As Long, _

ByVal lpOperation As String, _

ByVal lpFile As String, _

ByVal lpParameters As String, _

ByVal lpDirectory As String, _

ByVal nShowCmd As Long) As Long

Public Declare Function GetDesktopWindow _

Lib "user32" () As Long

Public Function StartDoc(DocName As String, Parameters As String, WindowsStyle As Byte)

Dim Scr_hDC As Long

Scr_hDC = GetDesktopWindow()

StartDoc = ShellExecute(Scr_hDC, "Open", DocName, Parameters, "c:\", WindowsStyle)

End Function

Ответить

Ответить

А что, относительные ссылки типа ie6sp1\setup.exe не работают?

Ответить

есть ВБ функция "Shell" чем она не нравится ?

Ответить

А тем не нравится что невозможно запускать относительные ссылки. как например указать чтоб при нажатии на Label1 автоматически определялась буква CD-ROM, а дальше из корневой папки запускать IE6\setup.exe? просто ie6\setup.exe не работает при том что папка ie6 находится в папке исходников.

Ответить

хм... хм почему нельзя определить что это сидиром ?.... можно ... определить все устройства ну и соотсвеннго выбрать .... из них СД ром .. и всё.... а потом сделать следующие..

Shell cd_path & my_path

П.С: АПИ (GetLogicalDriveStrings, GetDriveType)

Ответить

А конкретней? Ну вставил я апи функцию, а как ее вызывать? Я новичок понимаете так что мне все по буквочкам...

Ответить

'Example by Alexey (alexeyka2001@rambler.ru)

Private Const DRIVE_UNKNOWN = 0

Private Const DRIVE_ABSENT = 1

Private Const DRIVE_REMOVABLE = 2

Private Const DRIVE_FIXED = 3

Private Const DRIVE_REMOTE = 4

Private Const DRIVE_CDROM = 5

Private Const DRIVE_RAMDISK = 6

' returns errors for UNC Path

Private Const ERROR_BAD_DEVICE = 1200&

Private Const ERROR_CONNECTION_UNAVAIL = 1201&

Private Const ERROR_EXTENDED_ERROR = 1208&

Private Const ERROR_MORE_DATA = 234

Private Const ERROR_NOT_SUPPORTED = 50&

Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&

Private Const ERROR_NO_NETWORK = 1222&

Private Const ERROR_NOT_CONNECTED = 2250&

Private Const NO_ERROR = 0

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _

"WNetGetConnectionA" (ByVal lpszLocalName As String, _

ByVal lpszRemoteName As String, cbRemoteName As Long) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _

"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _

ByVal lpBuffer As String) As Long

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _

(ByVal nDrive As String) As Long

Private Function fGetDrives() As String

'Returns all mapped drives

Dim lngRet As Long

Dim strDrives As String * 255

Dim lngTmp As Long

lngTmp = Len(strDrives)

lngRet = GetLogicalDriveStrings(lngTmp, strDrives)

fGetDrives = Left(strDrives, lngRet)

End Function

Private Function fGetUNCPath(strDriveLetter As String) As String

On Local Error GoTo fGetUNCPath_Err

Dim Msg As String, lngReturn As Long

Dim lpszLocalName As String

Dim lpszRemoteName As String

Dim cbRemoteName As Long

lpszLocalName = strDriveLetter

lpszRemoteName = String$(255, Chr$(32))

cbRemoteName = Len(lpszRemoteName)

lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _

cbRemoteName)

Select Case lngReturn

Case ERROR_BAD_DEVICE

Msg = "Error: Bad Device"

Case ERROR_CONNECTION_UNAVAIL

Msg = "Error: Connection Un-Available"

Case ERROR_EXTENDED_ERROR

Msg = "Error: Extended Error"

Case ERROR_MORE_DATA

Msg = "Error: More Data"

Case ERROR_NOT_SUPPORTED

Msg = "Error: Feature not Supported"

Case ERROR_NO_NET_OR_BAD_PATH

Msg = "Error: No Network Available or Bad Path"

Case ERROR_NO_NETWORK

Msg = "Error: No Network Available"

Case ERROR_NOT_CONNECTED

Msg = "Error: Not Connected"

Case NO_ERROR

' all is successful...

End Select

If Len(Msg) Then

MsgBox Msg, vbInformation

Else

fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)

End If

fGetUNCPath_End:

Exit Function

fGetUNCPath_Err:

MsgBox Err.Description, vbInformation

Resume fGetUNCPath_End

End Function

Private Function fDriveType(strDriveName As String) As String

Dim lngRet As Long

Dim strDrive As String

lngRet = GetDriveType(strDriveName)

Select Case lngRet

Case DRIVE_UNKNOWN 'The drive type cannot be determined.

strDrive = "Unknown Drive Type"

Case DRIVE_ABSENT 'The root directory does not exist.

strDrive = "Drive does not exist"

Case DRIVE_REMOVABLE 'The drive can be removed from the drive.

strDrive = "Removable Media"

Case DRIVE_FIXED 'The disk cannot be removed from the drive.

strDrive = "Fixed Drive"

Case DRIVE_REMOTE 'The drive is a remote (network) drive.

strDrive = "Network Drive"

Case DRIVE_CDROM 'The drive is a CD-ROM drive.

strDrive = "CD Rom"

Case DRIVE_RAMDISK 'The drive is a RAM disk.

strDrive = "Ram Disk"

End Select

fDriveType = strDrive

End Function

Sub sListAllDrives()

Dim strAllDrives As String

Dim strTmp As String

strAllDrives = fGetDrives

If strAllDrives <> "" Then

Do

strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)

strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)

Select Case fDriveType(strTmp)

Case "Removable Media":

Debug.Print "Removable drive : " & strTmp

Case "CD Rom":

Debug.Print " CD Rom drive : " & strTmp

Case "Fixed Drive":

Debug.Print " Local drive : " & strTmp

Case "Network Drive":

Debug.Print " Network drive : " & strTmp

Debug.Print " UNC Path : " & _

fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))

End Select

Loop While strAllDrives <> ""

End If

End Sub

Private Sub Form_Load()

Debug.Print "All available drives: "

sListAllDrives

End Sub

вот тебе примерчик ..... который показывает как использовать эти АПИ функции .... выводит в Дебаг окно именна всех дисков и их тип .....

да кстати насчёт относительных ссылок всё.... можно ....

как понимаю относительно ... твоей прнограммки ?... то просто

App.path & my_path

app.path - возвращает путь к твоей программки...

Ответить

Whoa! Ну и примерчик! Небось долго писал ?

Ну,  спасибо, а попробую. Если я понимаю,то можно использовать так:

Shell (App.Path & "file.exe")?

Ответить

ну почти..., App.Path тебе выдаст путь к exe_шнику без "\", значит перед file.exe вставляй "\"

т.е. код должен быть : Shell (App.Path & "\file.exe")

2. - "Justas: А как вызывать твой пример? "

это не пример, это API-функция, а как вызвать - ответ №2.

Ответить

Функция "StartDoc(DocName As String, Parameters As String, WindowsStyle As Byte)" запускает программки и документы связанные с этими прогами.

Параметр "DocName" - имя файла который ты хош запускать.

Параметр "Parameters" - дополнительные параметры для запуска проги, т.е. ключи.

Параметр "WindowsStyle" - вид окна запущенной проги, т.е. свернутый, развернутый, свернутый в окно, с фокусом или без него, и.т.п..

Вота тебе констаны "WindowsStyle": vbNormalNoFocus, vbNormalFocus, vbMinimizedNoFocus, vbMinimizedFocus, vbMaximizedFocus, vbHide.

Если чё обращайся

Ответить