PC World Komputer 1999 January/pcwk_01_1999_B.iso/Lotus123/FRENCH/LOTUS023.DSK/ICONS/STARTAPP.LSS

Text File | 1996-09-18 | 7.5 KB | 304 lines

Declare Function GetPrivateProfileString Lib "Kernel" _
(Byval lpApplicationName As String, _
Byval lpKeyName As String, Byval lpDefault As String, _
Byval lpReturnedString As String, Byval nSize As Integer, _
Byval lpFileName As String) As Integer

Declare Function GetPrivateProfileStringA Lib "kernel32"_
Alias "GetPrivateProfileStringA"_
(Byval lpApplicationName As String, Byval lpKeyName As Any,_
Byval lpDefault As String, Byval lpReturnedString As String,_
Byval nSize As Long, Byval lpFileName As String) As Long

Declare Function GetWindowsDirectory LIB "kernel32" ALIAS "GetWindowsDirectoryA" (ByVal szBuf$,ByVal cbBuf&) AS LONG

' Registry declarations
Declare Function RegOpenKeyExA Lib "advapi32" Alias "RegOpenKeyExA" (Byval HKEY As Long,Byval lpszSubKey As String,Byval dwreserved As Integer,Byval samDesired As Long, keyresult As Long) As Long
Declare Function RegQueryValueExA Lib "advapi32" Alias "RegQueryValueExA" (Byval HKEY As Long,Byval lpszValueName As String,Byval dwreserved As Integer, lpdwtype As Long, Byval lpData As String, readbytes As Long) As Long
Declare Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long

'---------------------------- Helper Functions ---------------------------------------
FUNCTION NullTrim (szString$)
   DIM l%

   l% = INSTR (szString, CHR$(0))
   IF l% > 0 THEN
         NullTrim = RTrim$(LEFT$ (szString, l% - 1))
   ELSEIF l% = 0 THEN
         NullTrim = RTrim$(szString)
   ELSE
      NullTrim = ""
   END IF
END FUNCTION


FUNCTION GetWindowsDir()
   DIM szBufAl$, cbBuf&, szBuf$, rv&

    szBufAl$ = STRING$(256, " ")
   cbBuf&   = GetWindowsDirectory(szBufAl$, 256)

   IF cbBuf& = 0 THEN
      GetWindowsDir = ""
      Print SID_ERR_GETWINDOWSDIR, ""
      ERROR STFQUIT
   ELSE
       IF cbBuf& > 255 THEN
            Print SID_ERR_GETWINDOWSDIR2, ""
            ERROR STFQUIT
        END IF
        szBuf$ = NullTrim(szBufAl$)
        if Right(szBuf$,1) <> "\" THEN szBuf$ = szBuf$ + "\"
        GetWindowsDir = szBuf$
   END IF
END FUNCTION


Function GetWord(searchstr As String, sepstr As String, wordnum As Integer) As String
    Dim done As Integer
    done = False
    Dim beginpos As Integer
    beginpos = 0
    Dim endpos As Integer
    endpos = 0
    Dim i As Integer

    For i = 1 To wordnum
        beginpos = endpos + 1
        endpos = Instr(beginpos, searchstr, sepstr)
        If endpos = 0 Then
            endpos = Len(searchstr) + 1
            Exit For
        End If
    Next i

    GetWord = Mid$(searchstr,beginpos,endpos-beginpos)
End Function


Function SearchRegistry(ApplicationName, ExeName)
    ' Return the full path for an application
    ' the applicationName should be in the form of Approach.exe
    ' WordPro.exe etc..
    ' if "" is returned then the app was not found in the registry


    Dim hKey As Long
    Dim HKEY_LOCAL_MACHINE As Long
    Dim KEY_READ As Long
    Dim HKEY_CURRENT_USER As Long
    Dim ValueType As Long
    Dim ReturnedKeyContents As String * 255
    Dim readbytes As Long
    ReturnedKeycontents$=String$(255,Chr$(32))

    HKEY_LOCAL_MACHINE= &H80000002
    HKEY_CURRENT_USER= &H80000001

    KEY_QUERY_VALUE=1
    KEY_ENUMERATE_SUBKEYS=8
    KEY_NOTIFY=16
    KEY_READ=KEY_QUERY_VALUE Or KEY_ENUMERATE_SUBKEYS Or KEY_NOTIFY
    ReadBytes=255


'
'    1st try: Look Under "HLM\SoftWare\Microsoft\Windows\CurrentVersion\App Paths\"
'

    BaseName$ = "SoftWare\Microsoft\Windows\CurrentVersion\App Paths\"   ' this is your key
    KeyName$ = BaseName$ + ExeName
    ValueName$ = ""  ' this is your value to look up

    Statopen = RegOpenKeyExA(HKEY_LOCAL_MACHINE,KeyName$,0,KEY_READ,hKey)
    Print "OpenKey " StatOpen

    StatQuery = RegQueryValueExA(hKey,ValueName$,0,valueType, ReturnedKeyContents$,ReadBytes)
    Print "Query " StatQuery

    regclosekey(hKey)

    If StatQuery = Success Then
        SearchRegistry = Left$(ReturnedKeyContents$,ReadBytes-1)
        Exit Function
    End If


'
'    2nd try: Look Under "HLM\SoftWare\Lotus\" + ApplicationName + "\97.0\"
'

    KeyName$ = "SoftWare\Lotus\" + ApplicationName + "\97.0"   ' this is your key
    ValueName$ = "Path"  ' this is your value to look up

    Statopen = RegOpenKeyExA(HKEY_LOCAL_MACHINE,KeyName$,0,KEY_READ,hKey)
    Print "OpenKey " StatOpen

    StatQuery=RegQueryValueExA(hKey,ValueName$,0,valueType, ReturnedKeyContents$,ReadBytes)
    Print "Query " StatQuery

    If StatQuery = Success Then
        ExePath = Left$(ReturnedKeyContents$,ReadBytes-1)
    Else
        SearchRegistry = ""
        Exit Function
    End If

    ValueName$ = "Name"  ' this is your value to look up
    StatQuery = RegQueryValueExA(hKey,"Name",0,valueType, ReturnedKeyContents$,ReadBytes)
    Print "Query " StatQuery

    regclosekey(hKey)

    If StatQuery = Success Then
        ExeName=Left$(ReturnedKeyContents$,ReadBytes-1)
        SearchRegistry = ExePath + ExeName
        Exit Function
    Else
        SearchRegistry = ""
    End If
End Function

Function SearchIni(CommonName)
    Dim IniData As String * 255
    Dim IniData2 As String
    Dim Stat
    Dim IniFileName As String
    IniData = String$(255,0)
    IniFileName = GetWindowsDir() + "Lotus.Ini"

    If IsDefined("Win16") Then
        Stat = GetPrivateProfileString("Lotus Applications",CommonName,"",IniData,255,IniFileName)
        IniData2=Left$(IniData,Stat)
    End If

    If IsDefined("Win32") Then
        Stat = GetPrivateProfileStringA("Lotus Applications",CommonName,"",IniData,255,IniFileName)
        IniData2=Left$(IniData,Stat)
    End If

    If IniData2 <> "" Then
        IniData2 = GetWord(IniData2," ",1)

    End If

    SearchIni = IniData2
End Function


Function LaunchApp (ExeName, AppName, IniName)
'    ExeName : listed under HLM\SoftWare\Microsoft\Windows\CurrentVersion\App Paths\
'    AppName : listed under HLM\SoftWare\Lotus\
'    IniName : listed under lotus.ini


    WindowStyle = 3 ' Maximized with Focus
    Status = 0

    If IsDefined("Win32") Then
        FullPath = SearchRegistry(AppName, ExeName)
    End If

    If FullPath = "" Then
        FullPath = SearchIni(IniName)
    End If

    FullPath = Trim(FullPath)

    If FullPath <> "" Then
        Status =  Shell(FullPath,WindowStyle)
    End If

    LaunchApp = Status
End Function


Sub Main
End Sub


'---------------------------- Lauching Application ---------------------------------------
'    ExeName : listed under HLM\SoftWare\Microsoft\Windows\CurrentVersion\App Paths\
'    AppName : listed under HLM\SoftWare\Lotus\
'    IniName : listed under lotus.ini

Sub Acrobat
    ExeName = "acroread.exe"
    AppName = "DocOnline"
    IniName = "DocOnline"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub Approach()
    ExeName = "Approach.Exe"
    AppName = "Approach"
    IniName = "Approach"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub ccMail
    ExeName = "ccMail.exe"
    AppName = "ccMail"
    IniName = "ccMail"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub Freelance
    ExeName = "f32main.exe"
    AppName = "Freelance"
    IniName = "FLW"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub Notes
    ExeName = "Notes.exe"
    AppName = "Notes"
    IniName = "Notes"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub Organizer
    ExeName = "Org32.exe"
    AppName = "Organizer"
    IniName = "organize"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub Screencam
    ExeName = "scrncam.exe"
    AppName = "ScreenCam"
    IniName = "ScreenCam"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub


Sub WordPro
    ExeName = "WordPro.exe"
    AppName = "WordPro"
    IniName = "AmiPro"

    FullPath = LaunchApp(ExeName, AppName, IniName)
End Sub

Sub SmartPics
    ExeName = "SmartPics.exe"
    AppName = "SmartPics"
    IniName = "SmartPics"

    FullPath = ""
End Sub