home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 October A / Pcwk10a98.iso / Lotus / LOTUS / APPROACH / INETSRCH.LSS < prev    next >
Text File  |  1998-01-19  |  6KB  |  210 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.   query$ = Selection.Cell(0,0,0).contents
  112.   If query$ = "" Then
  113.         Beep
  114.         Messagebox NOTEXT, MB_OK, ERRSTR
  115.   Else
  116.  
  117.     Dim URL As String
  118.     URL$ = "http://search.yahoo.com/bin/search?p="& query$
  119.     
  120.  
  121.     ' ** Define the search key list **
  122.     ' ********************************
  123.     Dim strKeylist(3) As String
  124.     strKeylist(0) = "http"    'http
  125.     strKeylist(1) = "htmlfile"    'htmlfile
  126.     strKeylist(2) = ".htm"    '.htm
  127.     strKeylist(3) = ".html"    '.html
  128.     
  129.     ' ** Declare the variables needed **
  130.     ' ****************************************
  131.     Dim ReturnedKey As String * 255
  132.     'Dim DDEAppKey As String
  133.     'Dim DDETopicKey As String
  134.     'Dim ReturnedDDEAppKey As String
  135.     'Dim ReturnedDDETopicKey As String
  136.     Dim strSKey As String
  137.     Dim SeekKey As String
  138.     Dim BrowserPath As String
  139.     Dim LaunchPath As String
  140.     Dim stat As Variant
  141.     
  142.     Dim QuotePos As Integer
  143.     Dim ExePos As Integer
  144.     
  145.     
  146.     ' ** Iterate through the list of keyvalues until a valid one is found **
  147.     ' **********************************************************************
  148.     Forall strPKey In strKeylist
  149.         ReturnedKey = GetKey(strPKey)        
  150.         If ReturnedKey<>"" Then
  151.             'We got something.  Were we looking for a file extension...?
  152.             If Left$(strPKey, 1) = "." Then
  153.                 'Set the DDE command to nothing
  154.                 SeekKey = Trim$(ReturnedKey)
  155.                 'Strip out excess nulls
  156.                 While InStr(SeekKey, Chr$(0)) > 0
  157.                     SeekKey=Left$(SeekKey, InStr(SeekKey, Chr$(0)) -1)
  158.                 Wend
  159.             Else
  160.                 'We weren't looking for a file extension, so get DDE keys (to
  161.                 'send message to app if running) and command key (to launch app
  162.                 'if not already running)
  163.                 'DDEAppKey = strPKey+"\shell\open\ddeexec\Application"
  164.                 'DDETopicKey = strPKey+"\shell\open\ddeexec\Topic"
  165.                 'ReturnedDDEAppKey = GetKey (DDEAppKey)
  166.                 'ReturnedDDETopicKey = GetKey (DDETopicKey)
  167.                 SeekKey = strPKey
  168.             End If    
  169.             'Get the app key pointed to
  170.             strSKey= SeekKey+"\shell\open\command"
  171.             'Get the browser path
  172.             BrowserPath = GetKey (strSKey)
  173.              'Delete all command line params:
  174.             ExePos=Instr(1,BrowserPath,".exe",1)
  175.             If ExePos<>0 Then
  176.                 BrowserPath=Left$(BrowserPath,ExePos+4)
  177.             End If
  178.             'Return path without leading quote, if there is one:
  179.             QuotePos=Instr(BrowserPath,Chr$(34))
  180.             If QuotePos<>0 Then
  181.                 BrowserPath=Mid$(BrowserPath,QuotePos+1)
  182.                 QuotePos=Instr(BrowserPath, CHR$(34))
  183.                 If QuotePos<>0 Then
  184.                     Mid$(BrowserPath,QuotePos)=" "
  185.                 End If
  186.             End If
  187.             'Create the command to send to the shell
  188.             LaunchPath=BrowserPath+" "+URL
  189.             Err=0
  190.             On Error Resume Next
  191.             
  192.             ' ** Send the appropriate commands to the shell **
  193.             ' *********************************************************
  194.             'Send the command to application to change to a new URL
  195.             '(Hah!  Wishful thinking, that I could send a DDE command from Script.  Oh well.)
  196.  
  197.             'Send the command to the shell to launch a new browser
  198.             stat=Shell(LaunchPath, 1)
  199.             'If you successfully launched, you're done
  200.             If stat = 33 Then
  201.                 Exit Sub
  202.             End If
  203.             On Error Goto 0
  204.         End If    
  205.     End Forall
  206.     'None of the registry keys pointed to valid browsers, so send an error
  207.     Msgbox NOBROWSER
  208.   End If    
  209. End Sub
  210.