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