home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 October A / Pcwk10a98.iso / Lotus / LOTUS / APPROACH / LOTCSS.LSS < prev    next >
Text File  |  1998-04-06  |  6KB  |  204 lines
  1. Option Public
  2. 'Option Declare
  3.  
  4. Declare Public 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
  5. Declare Public Function RegQueryValueExA Lib "advapi32" _
  6.     Alias "RegQueryValueExA" _
  7.     (Byval HKEY As Long,_
  8.     Byval lpszValueName As String,_
  9.     Byval dwreserved As Integer, _
  10.     lpdwtype As Long, _
  11.     Byval lpData As String, _
  12.     readbytes As Long) As Long
  13. Declare Public Function RegCloseKey Lib "advapi32" _
  14.     Alias "RegCloseKey" (Byval HKEY As Long) As Long
  15. Declare Public Function GetPrivateProfileStringA Lib "kernel32" _
  16.     Alias "GetPrivateProfileStringA"_
  17.     (Byval AppName As String,_
  18.     Byval KName As Any, _
  19.     Byval Def As String, _
  20.     Byval RStr As String, _
  21.     Byval nSize As Integer, _
  22.     Byval FName As String) As Integer
  23.  
  24.  
  25. Function TranslateEnviron (myKeyValue As String) As String    
  26.     
  27.     ''We need this function for NT5 to find InternetExplorer 4.0 because it registers differently
  28.     'than any other version/operating system combination.
  29.     
  30.     Dim pos As Integer
  31.     Dim EnvVar As String
  32.     Dim ValueEnvVar As String
  33.     Dim exePos As Integer
  34.     
  35.     pos = Instr(1, myKeyValue, "%")
  36.         exePos=Instr(1,myKeyValue,".exe",1)  'Must be prior to .exe!
  37.     If ((pos > 0) And (pos < exePos)) Then
  38.         'We've located an environmental variable which needs substitution
  39.         
  40.         'Remove the leading % from the string
  41.         myKeyValue = Right$(myKeyValue, Len(myKeyValue) - pos)
  42.         
  43.         'Find the next % so we can extract the Environmental variable for translation        
  44.         pos = Instr(1, myKeyValue, "%")
  45.         
  46.         'Extract the Variable Name
  47.         EnvVar = Left$(myKeyValue, pos - 1)
  48.         
  49.         'Translate the variable        
  50.         ValueEnvVar = Environ(EnvVar)
  51.         
  52.         'Reassemble the string with the translated value        
  53.         myKeyValue = """" & ValueEnvVar & Right$(myKeyValue, Len(myKeyValue) - pos)
  54.         
  55.     End If
  56.     
  57.     'Return the new value
  58.     TranslateEnviron = myKeyValue
  59.     
  60. End Function
  61.  
  62.  
  63. Function GetKey (myKey As String) As String
  64.     
  65.     Dim HKEY_LOCAL_MACHINE As Long
  66.     Dim KEY_READ As Long
  67.     Dim HKEY_CURRENT_USER As Long
  68.     Dim HKEY_CLASSES_ROOT As Long
  69.     Dim KEY_QUERY_VALUE As Integer
  70.     Dim KEY_ENUMERATE_SUBKEYS As Integer
  71.     Dim KEY_NOTIFY As Integer
  72.     
  73.     
  74.     HKEY_CLASSES_ROOT= &H80000000
  75.     HKEY_CURRENT_USER= &H80000001
  76.     HKEY_LOCAL_MACHINE= &H80000002
  77.     
  78.     KEY_QUERY_VALUE=1
  79.     KEY_ENUMERATE_SUBKEYS=8
  80.     KEY_NOTIFY=16
  81.     KEY_READ=KEY_QUERY_VALUE Or KEY_ENUMERATE_SUBKEYS Or KEY_NOTIFY
  82.     
  83.     Dim lstat As Long    
  84.     Dim KeyVal As Long
  85.     Dim KeyReadBytes As Long
  86.     Dim ValueType As Long
  87.     Dim ValueName As String
  88.     Dim ReturnedKeyContents As String * 255
  89.     ReturnedKeyContents=String$(255,Chr$(32))
  90.     
  91.     'Open the registry and get the key address (myKey)
  92.     lstat=RegOpenKeyExA(HKEY_CLASSES_ROOT,myKey,0,KEY_READ,KeyVal)
  93.     KeyReadBytes = 255
  94.     'Get the value of the key at that address (ReturnedKeyContents)
  95.     lstat=RegQueryValueExA(KeyVal,ValueName,0,ValueType, _
  96.     ReturnedKeyContents,KeyReadBytes)
  97.     'Close the registry, thank you (you wouldn't want the keys to escape!)
  98.     regclosekey(KeyVal)
  99.     
  100.     'Get rid of the extra characters in the keystring
  101.     ReturnedKeyContents = Rtrim$(ReturnedKeyContents)
  102.     ReturnedKeyContents = Left$(ReturnedKeyContents,(Len(ReturnedKeyContents)-1))
  103.     
  104.     ReturnedKeyContents = TranslateEnviron(ReturnedKeyContents)
  105.  
  106.     GetKey = ReturnedKeyContents
  107. End Function
  108.  
  109.  
  110.  
  111. Sub Main
  112.     %Include "Inistrs.lss"
  113. Dim URL As String
  114.     URL$=" http://www.support.lotus.com"    'The URL to open
  115.     
  116.     ' ** Define the search key list **
  117.     ' ********************************
  118.     Dim strKeylist(3) As String
  119.     strKeylist(0) = "http"    'http
  120.     strKeylist(1) = "htmlfile"    'htmlfile
  121.     strKeylist(2) = ".htm"    '.htm
  122.     strKeylist(3) = ".html"    '.html
  123.     
  124.     ' ** Declare the variables needed **
  125.     ' ****************************************
  126.     Dim ReturnedKey As String * 255
  127.     'Dim DDEAppKey As String
  128.     'Dim DDETopicKey As String
  129.     'Dim ReturnedDDEAppKey As String
  130.     'Dim ReturnedDDETopicKey As String
  131.     Dim strSKey As String
  132.     Dim SeekKey As String
  133.     Dim BrowserPath As String
  134.     Dim LaunchPath As String
  135.     Dim stat As Variant
  136.     
  137.     Dim QuotePos As Integer
  138.     Dim ExePos As Integer
  139.     
  140.     
  141.     ' ** Iterate through the list of keyvalues until a valid one is found **
  142.     ' **********************************************************************
  143.     Forall strPKey In strKeylist
  144.         ReturnedKey = GetKey(strPKey)        
  145.         If ReturnedKey<>"" Then
  146.             'We got something.  Were we looking for a file extension...?
  147.             If Left$(strPKey, 1) = "." Then
  148.                 'Set the DDE command to nothing
  149.                 SeekKey = Trim$(ReturnedKey)
  150.                 'Strip out excess nulls
  151.                 While InStr(SeekKey, Chr$(0)) > 0
  152.                     SeekKey=Left$(SeekKey, InStr(SeekKey, Chr$(0)) -1)
  153.                 Wend
  154.             Else
  155.                 'We weren't looking for a file extension, so get DDE keys (to
  156.                 'send message to app if running) and command key (to launch app
  157.                 'if not already running)
  158.                 'DDEAppKey = strPKey+"\shell\open\ddeexec\Application"
  159.                 'DDETopicKey = strPKey+"\shell\open\ddeexec\Topic"
  160.                 'ReturnedDDEAppKey = GetKey (DDEAppKey)
  161.                 'ReturnedDDETopicKey = GetKey (DDETopicKey)
  162.                 SeekKey = strPKey
  163.             End If    
  164.             'Get the app key pointed to
  165.             strSKey= SeekKey+"\shell\open\command"
  166.             'Get the browser path
  167.             BrowserPath = GetKey (strSKey)
  168.              'Delete all command line params:
  169.             ExePos=Instr(1,BrowserPath,".exe",1)
  170.             If ExePos<>0 Then
  171.                 BrowserPath=Left$(BrowserPath,ExePos+4)
  172.             End If
  173.             'Return path without leading quote, if there is one:
  174.             QuotePos=Instr(BrowserPath,Chr$(34))
  175.             If QuotePos<>0 Then
  176.                 BrowserPath=Mid$(BrowserPath,QuotePos+1)
  177.                 QuotePos=Instr(BrowserPath, CHR$(34))
  178.                 If QuotePos<>0 Then
  179.                     Mid$(BrowserPath,QuotePos)=" "
  180.                 End If
  181.             End If
  182.             'Create the command to send to the shell
  183.             LaunchPath=BrowserPath+" "+URL
  184.             Err=0
  185.             On Error Resume Next
  186.             
  187.             ' ** Send the appropriate commands to the shell **
  188.             ' *********************************************************
  189.             'Send the command to application to change to a new URL
  190.  
  191.             'Send the command to the shell to launch a new browser
  192.             stat=Shell(LaunchPath, 1)
  193.             'If you successfully launched, you're done
  194.             If stat = 33 Then
  195.                 Exit Sub
  196.             End If
  197.             On Error Goto 0
  198.         End If    
  199.     End Forall
  200.     'None of the registry keys pointed to valid browsers, so send an error
  201.     Msgbox NOBROWSER
  202.     
  203. End Sub
  204.