Newsgroup: it.comp.lang.visual-basic
Titolo: shell function

I have a application that calls notepad to open
I was wondering if its possible to pass a document
as a argument to notepad and have it open the document
when it loads.
Any help would be much appreciated
Thanks
Ryan Healey

...


 Ryan Healey
'====================================================
'Tipos de Aplicaciones a las que se puede llamar desde esta
'====================================================
Global Const CTE_TA_THIS_APPLICATION_ITSELF = 0
Global Const CTE_TA_NOTEPAD = 1
Global Const CTE_TA_WORD = 2
Global Const CTE_TA_EXCEL = 3
Global Const CTE_TA_NETSCAPE = 4
Global Const CTE_TA_BAT_FILE = 5
Global Const CTE_TA_CALCULATOR = 6
Global Const CTE_TA_EXPLORER = 7
Global Const CTE_NF_11_GENERICO1 = 11
Global Const CTE_NF_12_GENERICO2 = 12
Sub callApplication(applicacionType As Integer, callOptions As String)
    On Error Resume Next
    Dim RetVal As Variant
    Dim comando As String
'Las ejecuciones con start usan paths de MS-DOS con ~1 etc
'Otro método
'Private 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
'Dim lValDev     As Long
'lValDev = ShellExecute(Me.hwnd, "Open", "c:\splash.mid",         "",
"", 1)
    Select Case applicacionType
        Case CTE_TA_ESTA_MISMA_APLICACION
            If Len(callOptions) > 0 Then
                If Not fileExists(callOptions) Then
                    s_error_ger CTE_ERROR_GRAVE, "No existe el fichero "
& callOptions
                    Exit Sub
                End If
                comando = completeFilename(path_largo_app(CTE_C_RAIZ),
App.EXEName) & " " & callOptions
             Else
                comando = completeFilename(path_largo_app(CTE_C_RAIZ),
App.EXEName)
             End If
        Case CTE_TA_NOTEPAD
            If Len(callOptions) > 0 Then
                If Not fileExists(callOptions) Then
                    s_error_ger CTE_ERROR_GRAVE, "No existe el fichero "
& callOptions
                    Exit Sub
                End If
                comando = "notepad.exe " & callOptions
             Else
                comando = "notepad.exe"
             End If
        Case CTE_TA_WORD
            If Not fileExists(callOptions) Then
                s_error_ger CTE_ERROR_GRAVE, "No existe el fichero " &
callOptions
                Exit Sub
            End If
            comando = "start " & existingFile2MsdosFile(callOptions)
        Case CTE_TA_EXCEL
            If Not fileExists(callOptions) Then
                s_error_ger CTE_ERROR_GRAVE, "No existe el fichero " &
callOptions
                Exit Sub
            End If
            comando = "start " & existingFile2MsdosFile(callOptions)
        Case CTE_TA_NETSCAPE
            If Not fileExists(callOptions) Then
                s_error_ger CTE_ERROR_GRAVE, "No existe el fichero " &
callOptions
                Exit Sub
            End If
            comando = "start " & existingFile2MsdosFile(callOptions)
        Case CTE_TA_FICHERO_BAT
            If Not fileExists(callOptions) Then
                s_error_ger CTE_ERROR_GRAVE, "No existe el fichero " &
callOptions
                Exit Sub
            End If
            comando = existingFile2MsdosFile(callOptions)
        Case CTE_TA_CALCULADORA
            comando = "calc.exe"
        Case CTE_TA_EXPLORER
            comando = "explorer /n,/e," & callOptions
        Case Else
            s_error_ger CTE_ERROR_GRAVE, "Tipo de aplicación no
identificado " & applicacionType
    End Select
    RetVal = Shell(comando, vbNormalFocus)
    'RetVal = Shell(comando, vbMinimizedNoFocus)
    If IsEmpty(RetVal) Then
        s_error_ger CTE_ERROR_GRAVE, "No se ha podido llamar al
ejecutable " & comando
    End If
End Sub
Function existingFile2MsdosFile(myfile As String) As String
    Dim myarray() As String
    Dim i As Integer
    Dim num_fields As Integer
    Dim nombre_sin_extension As String
    Dim extension_con_punto As String
    Dim ret As String
    myfile = f_sustituir_subcadena_todas(myfile, "/", "\")
    num_fields = loadArrayWithFieldsOfLine(myfile, myarray(), "\",
CTE_NO_QUOTED_FIELDS, CTE_NO_2_SEP_AS_ONE)
    ret = ""
    'Carpetas
    For i = 1 To num_fields - 1
        If (Len(myarray(i)) > 8 And InStr(1, myarray(i), ".") = 0) Or
(Len(myarray(i)) > 12) Or (InStr(1, myarray(i), ".") > 0 And
Len(myarray(i)) - InStr(1, myarray(i), ".") > 3) Or InStr(myarray(i), "
") > 0 Then
            myarray(i) = f_sustituir_subcadena_todas(myarray(i), " ",
"")
            If InStr(1, myarray(i), ".") = 0 Then
                ret = ret & left(myarray(i), 6) & "~1" & "\"
            Else
                ret = ret & left(myarray(i), 6) & "~1" & "." &
right(myarray(i), Len(myarray(i)) - InStr(1, myarray(i), ".")) & "\"
            End If
        Else
            ret = ret & myarray(i) & "\"
        End If
    Next i
    'Nombre de archivo
    nombre_sin_extension = nameWithoutExtension(myarray(num_fields))
    extension_con_punto = extensionWithDot(myarray(num_fields))
    If Len(nombre_sin_extension) > 8 Or Len(extension_con_punto) > 4
Then
        ret = ret & left(nombre_sin_extension, 6) & "~1" &
left(extension_con_punto, 4)
    Else
        ret = ret & nombre_sin_extension & extension_con_punto
    End If
    existingFile2MsdosFile = ret
End Function
Function fileExists(fic As String) As Boolean
'No debe usar openFile ni closeFile
    On Error GoTo no_existe
    Open fic For Input As #CTE_NF_11_GENERICO1
    'Si no existe se produce un error en este punto
    'y no se abre
    'Si sigue por aqui es que si existe
    Close #CTE_NF_11_GENERICO1
    DoEvents
    fileExists = True
    Exit Function
no_existe:
    fileExists = False
    Exit Function
End Function
Function completeFilename(p_path As String, p_fichero As String) As
String
    'Si en p_fichero viene el path completo y no solo el nombre,
    'uso el path completo
    If nameOfFile(p_fichero) <> p_fichero Then
        completeFilename = p_fichero
    Else
        If right(p_path, 1) = "\" Or right(p_path, 1) = "/" Then
            completeFilename = p_path & p_fichero
        Else
            completeFilename = p_path & "\" & p_fichero
        End If
    End If
End Function
Function nameOfFile(path_mas_nombre As String) As String
    Dim pos As Integer
    Dim tmp As String
    Dim cuenta_quitado As Integer
    cuenta_quitado = 0
    'Busco la posicion de la barra mas a la derecha
    tmp = path_mas_nombre
    'Mientras haya barras
    While InStr(tmp, "\") <> 0 Or InStr(tmp, "/") <> 0
        pos = InStr(tmp, "\")
        If InStr(tmp, "/") > pos Then
            pos = InStr(tmp, "/")
        End If
        'quito esa parte
        tmp = right(tmp, Len(tmp) - pos)
        cuenta_quitado = cuenta_quitado + pos
    Wend
    'Ya se cual es la ultima barra
    nameOfFile = right(path_mas_nombre, Len(path_mas_nombre) -
cuenta_quitado)
End Function