It could be argued that if the author and created fields need to hold exactly the values relative to the Notes document, not the domain document, then the @Author and @Created functions do the job. But this is a mistake as well, because their values may change without notice: for example the creation date changes when a document is cut from and pasted again into the database.

So, if a piece of information makes any sense for a document it needs to stay in its own field in the form.

Notes main flexibility is that it’s possible to add new fields at any time. A natural way of adding such two fields to a form is by means of Computed When Composed fields, whose formulas could be @Author and @Created respectively.

In fact, all of the conection data that would usually go into the tnsnames.ora configuration file, can be much more conveniently stored inside a LotusScript library, like the following

'Connection_Oracle: Option Public Option Declare Const connection_Host = "172.18.32.51" Const connection_Port = "1525" Const connection_SID = "extprd" Const connection_UserId = "Notes Log" Const connection_Password = "Notes Log" Dim connection_Server As String Sub Initialize connection_Server = {} _ & {(DESCRIPTION=} _ & {(ADDRESS_LIST=} _ & {(ADDRESS=} _ & {(PROTOCOL=TCP)(Host=} & connection_Host & {)(Port=} & connection_Port & {)} _ & {)} _ & {)} _ & {(CONNECT_DATA=} _ & {(SID=} & connection_SID & {)} _ & {)} _ & {)} End Sub

Booking a company ID

This is a very simple use of the Lotus Connector clockwork.
There is a SAP application where companies are added to a database using a SAP data entry screen. For some reason, the time at which all the needed data is available, is too far in the future (;-), and some guy needs the company ID as soon as possible, well before the SAP application will provide one.

Behind the scenes, the SAP application returns as a company ID the record ID of that company into the companies Oracle table. Finally that record ID is a value of an Oracle sequence, which is incremented whenever a new record is added to the companies table. So it is possible to book a company ID, simply by incrementing the sequence. This means that no record is added to the database, but that ID is unique and will never be used for any other record.

'BookCompanyID: Option Public Option Declare Uselsx "*LSXLC" Use "Connection Oracle" Function BookCompanyID As Long On Error Goto HandleError Dim session As New LCSession session.ClearStatus Goto Begin HandleError: Dim errmsg As String errmsg = "Error " & Err & Chr$( 10 ) _ & Getthreadinfo( 1 ) & ":" & Erl & Chr$( 10 ) If session.Status <> LCSUCCESS Then errmsg = errmsg & session.GetStatusText Else errmsg = errmsg & Error$ End If Error Err, errmsg Begin: Dim sqlNextval As String sqlNextval = { SELECT SQ_COMPANIES.NEXTVAL FROM DUAL } Dim connection As New LCConnection( "oracle8" ) connection.Server = connection_Server connection.UserId = connection_UserId connection.Password = connection_Password '------------------------------------------------------------------------------------------- connection.Connect Dim fields As New LCFieldList Call connection.Execute( sqlNextval, fields ) Dim nextVal As LCField Set nextVal = fields.Lookup( "NEXTVAL" ) Call connection.Fetch( fields ) BookCompanyID = nextVal.Value( 0 ) Done: connection.Disconnect '------------------------------------------------------------------------------------------- End Function

When saving the document, just join the text values of the fields in an ordered manner, then get the CRC of that string and store it as a new field value. When checking the document for changes to those fields, make the string again and get its CRC. If the saved CRC and the one just computed are equal, then you should be reasonably sure that those field values have not changed, but if the CRC does change, then you can be completely sure that those field have changed as well!

A CRC32 class comes with the java.util.zip package, and LS2J can be used to access and use it.

Here is the code for a Java library, name it CRC32 Java

import java.util.zip.CRC32;

public class StringCRC32 {

    public static String StringCRC32 ( String s )
    {
        byte[] b = s.getBytes();

        CRC32 crc = new CRC32();

        for ( int i=0; i
And here is a LS2J wrapper, just for making it simpler to use in LotusScript. It’s a LotusScript library and you should name it CRC32
'CRC32:

Option Public
Option Declare

Use "CRC32 Java"
Uselsx "*javacon"

Function StringCRC32( aString As String ) As String
    Dim jSession As JavaSession
    Set jSession = New JavaSession
    Dim jClass As JavaClass
    Set jClass = jSession.GetClass( "StringCRC32" )
    StringCRC32 = jClass.StringCRC32( aString )
End Function
 
]]>
			http://noteslog.com/post/crc32/feed/
		0
		
		
		
		http://noteslog.com/post/hacking-2-needed/
		http://noteslog.com/post/hacking-2-needed/#comments
		Sun, 09 Apr 2006 09:13:52 +0000
		Andrea Ercolino
				

		http://noteslog.com/?p=20
		
			I’d like I could use parallel assignment in LotusScript. It’s the britghtest single programming concept I discovered in the past year, studying Ruby and other scripting languages. 

It’s fairly symmetrical to the argument passing concept and it really enhances code readability.
]]>
			http://noteslog.com/post/hacking-2-needed/feed/
		0
		
		
		
		http://noteslog.com/post/ole-constants/
		http://noteslog.com/post/ole-constants/#comments
		Sat, 11 Mar 2006 16:14:32 +0000
		Andrea Ercolino
				

		http://noteslog.com/?p=18
		
			Microsoft Office products like Word, Excel and Project can be accessed by LotusScript code running on a Windows machine through the OLE interface made available by the CreateObject function:

Dim pjApp As Variant
Set pjApp = CreateObject( "MSProject.Application" )
A handle to an OLE root object is a simple and mighty link to (almost) every property and method of the interfaced application.
Certainly not reachable are the constants, and I cannot guess any reason for this. MS Project 2003 has some 3,800 constants defined. All of them are well described in the online manual, but none of them is ever linked to any of the objects reachable from the root object. They are available from insibe the VBA macros, simply because MSProject is the object library and the VBA runtime generates an object for it. So the constant pjTimescaleDays, which is a member of the enumeration PjTimescaleUnit, is defined by the path
MSProject.PjTimescaleUnit.pjTimescaleDays
In fact VBA programmers are more lucky, because the VBA runtime makes an alias for each constant so that the last identificator is enough.
In my programs I could put Const pjTimescaleDays = 4, it’s just a matter of copy and paste from the Object Browser integrated in the VBA IDE. But this procedure can quickly become annoying, because the whole corpus of help articles and examples heavily rely on the VBA runtime aliasing feature. And if a Notes agent needs access to just a 10% of all of the available constants, then it’s really cumbersome to manually build the 400 lines of constants. And they are constant in a subtle way, i.e. until the product vendor suddenly change them.
To access constants defined in OLE applications the VBA Object Browser uses the Tlbinf32.dll library. Luckily enough this library is just another OLE application which can be directly used in LotusScript code.

It officially ships with Visual Studio, but if you haven’t got it already (it sould be in the windows \system32 folder), you can download the Tlbinf32.dll library from afreedll.com.
a good article about the Tlbinf32.dll library

a useful manual for the Tlbinf32.dll library
Example
To show how you can load OLE constants and use them to effectively simplify and make your code selfdocumented, here is a simple agent for importing MS Project tasks into Notes documents.
'Import tasks from MSProject:

Option Public
Option Declare

Use "DoubleLists"
Use "RegistryAccess"

' replace this comment with code in Block 1
' replace this comment with code in Block 2
' replace this comment with code in Block 3
Block 1: How to load OLE constants
Dim pjConst List As Long

Function GetOLEConstant( typeLibInfo As Variant, Byval enumName As String, Byval itemName As String ) As Long
%INCLUDE "error_handling"

    GetOLEConstant = typeLibInfo.TypeInfos.NamedItem( enumName ).GetMember( itemName ).Value

End Function

Sub Load_pjConst
%INCLUDE "error_handling"

    Dim tli As Variant '= Object
    Set tli = CreateObject( "TLI.TLIApplication" )

    Dim MSPRJ_OLB As Variant '= Object
    Set MSPRJ_OLB = tli.TypeLibInfoFromFile( GetPathToMSPRJ_OLB )

    Dim MSO_DLL As Variant '= Object
    Set MSO_DLL = tli.TypeLibInfoFromFile( GetPathToMSO_DLL )

    Dim pjConstLibrary List As Variant '= List As Object
    Set List2( pjConstLibrary, "PjField"            , "pjTaskID" )              = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjField"            , "pjTaskName" )            = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjField"            , "pjTaskSummary" )         = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjField"            , "pjTaskMilestone" )       = MSPRJ_OLB
    Set List2( pjConstLibrary, "PjTimescaleUnit"    , "pjTimescaleDays" )       = MSPRJ_OLB
    Set List2( pjConstLibrary, "MsoDocProperties"   , "msoPropertyTypeString" ) = MSO_DLL

    Forall enumLib In pjConstLibrary

        Dim enumName As String
        enumName = Listtag( enumLib )

        Forall itemLib In enumLib

            Dim itemName As String
            itemName = Listtag( itemLib )

            pjConst( itemName ) = GetOLEConstant( itemLib, enumName, itemName )

        End Forall
    End Forall

End Sub
Block 2: How to find the path to the object libraries
Function GetPathToMSPRJ_OLB
%INCLUDE "error_handling"

    Dim clsid As String
    clsid = RegQueryValue( "HKEY_CLASSES_ROOT", "MSProject.ApplicationCLSID", "" )

    Dim appPath As String
    appPath = RegQueryValue( "HKEY_CLASSES_ROOT", "CLSID" & clsid & "LocalServer32", "" )

    GetPathToMSPRJ_OLB = Strleftback( appPath, "" ) & "MSPRJ.OLB"

End Function

Function GetPathToMSO_DLL
%INCLUDE "error_handling"

    Dim clsid As String
    clsid = RegQueryValue( "HKEY_CLASSES_ROOT", "OfficeCompatible.ApplicationCLSID", "" )

    Dim appPath As String
    appPath = RegQueryValue( "HKEY_CLASSES_ROOT", "CLSID" & clsid & "InprocServer32", "" )

    GetPathToMSO_DLL = appPath

End Function
Block 3: How to import many Project fields at once
Sub Initialize
%INCLUDE "error_handling"

    Dim s As New NotesSession
    Dim db As NotesDatabase
    Set db = s.CurrentDatabase

    Dim pjApp As Variant '= Object
    Set pjApp = CreateObject( "MSProject.Application" )

    Call pjApp.FileOpen( "c:sample.mpp" )
    pjApp.Visible = False

    Dim pjProject As Variant '= Object
    Set pjProject = pjApp.ActiveProject

    Dim pjTaskCollection As Variant '= Object
    Set pjTaskCollection = pjProject.Tasks

    Call Load_pjConst

    Dim fieldIDList List As Long
    fieldIDList( "LineNumber" )   = pjConst( "pjTaskID" )
    fieldIDList( "Title" )        = pjConst( "pjTaskName" )
    fieldIDList( "IsSummary" )    = pjConst( "pjTaskSummary" )
    fieldIDList( "IsMilestone" )  = pjConst( "pjTaskMilestone" )

    Forall pjTask In pjTaskCollection
        If Not( pjTask Is Nothing ) Then
            Dim d As New NotesDocument( db )
            d.Form = "Task"

            Forall fieldID In fieldIDList
                Dim fieldName As String
                fieldName = Listtag( fieldID )
                Dim fieldValue As Variant
                fieldValue = pjTask.GetField( fieldID )
                Call d.ReplaceItemValue( fieldName, fieldValue )
            End Forall

            Call d.Save( True, True, True )
        End If
    End Forall

End Sub
Installing the Tlbinf32.dll library
Before using its services, the Tlbinf32.dll library needs to be properly installed. This is done by putting its file in the windows \system32 folder and then by registering it. This means that the user has to have administrator rights to their PC. As usual, you can implement the auto install feature for a needed file in a Notes database in three steps:

Attach the file to the About Database document and hide its paragraph
Add the @Command( [RunAgent]; “(Install Tlbinf32.dll)” ) to the Post Open event of the Database Script
Add the following agent to the database and name it (Install Tlbinf32.dll)

'Install tlbinf32.dll:

Option Public
Option Declare

Use "RegistryAccess"

Sub Initialize
%INCLUDE "error_handling"

    Dim tli As Variant
    On Error Resume Next
    Set tli = CreateObject( "TLI.TLIApplication" )
    On Error Goto HandleError
    If Err = 0 Then
        Set tli = Nothing
        Exit Sub
    End If

    Dim instalar As String
    instalar = "tlbinf32.dll"

    Dim s As New NotesSession
    Dim db As NotesDatabase
    Set db = s.CurrentDatabase

    Dim d As notesdocument
    Set d = GetHelpAboutDocument( db, instalar )
    If d Is Nothing Then
        Msgbox "The library " & instalar & " has not been installed" & Chr( 10 ) _
        & "The library could not be found in the database" & Chr( 10 ) _
        & "Please notify your admin"
        Exit Sub
    End If

    Dim systemRoot As String
    systemRoot = RegQueryValue( "HKEY_LOCAL_MACHINE", "SOFTWAREMicrosoftWindows NTCurrentVersion", "SystemRoot" )

    Dim path As String
    path = systemRoot & "system32" & instalar

    Call ExtractAttachment( d, instalar, path )
    If Dir( path ) = "" Then
        Msgbox "The library " & instalar & " has not been installed" & Chr( 10 ) _
        & "The library could not be put in the folder " & path & Chr( 10 ) _
        & "Please notify your admin"
        Exit Sub
    End If

    If Shell( "regsvr32 /s " & instalar ) <> 33 Then
        Msgbox "The library " & instalar & " has not been installed" & Chr( 10 ) _
        & "The library could not be registered" & Chr( 10 ) _
        & "Please notify your admin"
        Exit Sub
    End If

    Msgbox "The library " & instalar & " has been installed"

    ' HKEY_CLASSES_ROOTCLSID{8B217746-717D-11CE-AB5B-D41203C10000}InprocServer32

End Sub

Function GetHelpAboutDocument( db As NotesDatabase, filename As String ) As NotesDocument
%INCLUDE "error_handling"

    Dim nc As NotesNoteCollection
    Set nc = db.CreateNoteCollection( False )
    nc.SelectHelpAbout = True
    Call nc.BuildCollection
    Dim nid As String
    nid = nc.GetFirstNoteId

    If nid <> "" Then
        Set GetHelpAboutDocument = db.GetDocumentByID( nid )
    Else
        Set GetHelpAboutDocument = Nothing
    End If
End Function

Sub ExtractAttachment( d As NotesDocument, filename As String, path As String )
%INCLUDE "error_handling"

    If Not d.HasEmbedded Then Exit Sub

    Dim embedded As NotesEmbeddedObject
    Set embedded = d.GetAttachment( filename )
    If embedded Is Nothing Then Exit Sub

    Call embedded.ExtractFile( path )
End Sub
]]>
			http://noteslog.com/post/ole-constants/feed/
		1
		
		
		
		http://noteslog.com/post/double-lists/
		http://noteslog.com/post/double-lists/#comments
		Sun, 05 Mar 2006 21:44:05 +0000
		Andrea Ercolino
				

		http://noteslog.com/?p=17
		
			I use many lists in my programs. They are handy for keeping it tidy and configurable. I surely could put a constant in its own identificator and sometimes I do. But what if I need two or more similar constants? Lists are definitely the best choice for holding column numbers and for exchanging fields between Office and Notes documents.

Sometimes double lists would be better than normal lists. Example: an agent for importing some fields from an Excel book with many sheets into a Notes document using a double list for declaring the import structure. It should work this way:
Dim xlImport List2 As String
xlImport( "Sheet1", "report" ) = "Title"
xlImport( "Sheet2", "date3" ) = "Date"
xlImport( "Sheet1", "dept" ) = "Department"
With such a structure one could define the import as a simple forall loop:
Dim xlSheet As Variant
Dim xlRange As Variant
Forall f In xlImport
  xlSheet = xlBook.Worksheets( Listtag( f, 1 ) )
  xlRange = xlSheet.Range( Listtag( f, 2 ) )
  Call notesDocument.ReplaceItemValue( f, xlRange.Value )
End Forall
Unfortunately double lists don’t exist in LotusScript, so there is no chance for that code to run in a Notes system.
Here is my implementation of double lists, in its own “DoubleLists” script library. Its use is very similar to the one described earlier, but this is working code.
Dim xlImport List As Variant '= List As String
List2( xlImport, "Sheet1", "report" ) = "Title"
List2( xlImport, "Sheet2", "date3" ) = "Date"
List2( xlImport, "Sheet1", "dept" ) = "Department"

Forall sheet In xlImport
  xlSheet = xlBook.Worksheets( Listtag( sheet ) )
  Forall f In sheet
    xlRange = xlSheet.Range( Listtag( f ) )
    Call notesDocument.ReplaceItemValue( f, xlRange.Value )
  End Forall
End Forall 
The important thing here is the flexibility of this approach, something similar to the Prolog programming language. The import machine is known and fixed, but by means of a simple set of declarations it can import any book. And adding a new field to import is just a matter of copy and paste a declaration and adjust it, as well as stopping the import of a field is just a matter of commenting out a declaration. And the program gets self documented. These are the reasons why I use lists and double lists as much as possible.
'DoubleLists:

Option Public
Option Declare

Use "LsConst.lss"

Property Set List2( aList As Variant, tag1 As String, tag2 As String ) As Variant
%INCLUDE "error_handling"

    If Iselement( aList( tag1 ) ) Then
        Dim aux1 As Variant '= List
        aux1 = aList( tag1 )
        Select Case Datatype( List2 )
        Case V_DISPATCH, V_ERROR, V_IUNKNOWN, V_LSOBJ, V_PRODOBJ
            Set aux1( tag2 ) = List2
        Case Else
            aux1( tag2 ) = List2
        End Select
        aList( tag1 ) = aux1
    Else
        Dim aux2 List As Variant
        Select Case Datatype( List2 )
        Case V_DISPATCH, V_ERROR, V_IUNKNOWN, V_LSOBJ, V_PRODOBJ
            Set aux2( tag2 ) = List2
        Case Else
            aux2( tag2 ) = List2
        End Select
        aList( tag1 ) = aux2
    End If
End Property

Property Get List2( aList As Variant, tag1 As String, tag2 As String ) As Variant
%INCLUDE "error_handling"

    If Iselement( aList( tag1 ) ) Then
        Dim aux As Variant
        aux = aList( tag1 )
        If Iselement( aux( tag2 ) ) Then
            Select Case Datatype( aux( tag2 ) )
            Case V_DISPATCH, V_ERROR, V_IUNKNOWN, V_LSOBJ, V_PRODOBJ
                Set List2 = aux( tag2 )
            Case Else
                List2 = aux( tag2 )
            End Select
        Else
            List2 = Null
        End If
    Else
        List2 = Null
    End If
End Property
 
]]>
			http://noteslog.com/post/double-lists/feed/
		0
		
		
		
		http://noteslog.com/post/auto-install/
		http://noteslog.com/post/auto-install/#comments
		Sun, 26 Feb 2006 00:00:13 +0000
		Andrea Ercolino
				

		http://noteslog.com/?p=16
		
			The error_handling.lss file I described in a previous post needs to be available on any machine where the script using it will execute. This is due to a weird behavior of the Notes engine when processing the %Include instruction: The inclusion is done at execution time if executing on a client and at compilation time if executing on a server.

It is certainly possible to distribute a file to all the users, explaining in which folder to copy it, but it is much simpler to have the same database that use it to install it whenever needed.
The HelpAbout document is a good place for storing a file. After attaching it, a HideWhen formula will prevent it from showing up to the user. Then a simple (Install error_handling.lss) agent will extract the file to the proper folder (if the folder doesn’t already have one). And the formula @Command( [RunAgent]; "(Install error_handling.lss)" ) in the PostOpen event of the Database Script library will run the agent each time the user opens the database.
Here is the code for the agent:
'Install error_handling.lss:

Option Public
Option Declare

Use "RegistryAccess"

Sub Initialize
    On Error Goto HandleError
    Goto EnterProc

HandleError:
    Error Err, Getthreadinfo( 1 ) & " : " & Erl & Chr$( 10 ) & Error$

EnterProc:

    Dim install As String
    install = "error_handling.lss"

    Dim notesFolder As String
    notesFolder = RegQueryValue( "HKEY_LOCAL_MACHINE", "SoftwareLotusNotes", "Path" )
    Dim path As String
    path = notesFolder & install
    If Dir$( path ) <> "" Then
        ' exit on library already installed
        Exit Sub
    End If

    Dim s As New NotesSession
    Dim db As NotesDatabase
    Set db = s.CurrentDatabase

    Dim d As notesdocument
    Set d = GetHelpAboutDocument( db )
    If d Is Nothing Then
        ' exit on library not available in the database
        Msgbox "The library " & install & " must be installed" & Chr( 10 ) _
        & "It's not in the database" & Chr( 10 ) _
        & "Contact the administrator of this database"
        Exit Sub
    End If

    Call ExtractAttachment( d, install, path )
    If Dir( path ) = "" Then
        ' exit on file not created
        Msgbox "The library " & install & " must be installed" & Chr( 10 ) _
        & "The file " & path & " couldn't be created" & Chr( 10 ) _
        & "Contact the administrator of this database"
        Exit Sub
    End If
    Print "Installed library " & install

    install = "error_handling_ui.lss"
    path = notesFolder & install
    Call ExtractAttachment( d, install, path )
    If Dir( path ) = "" Then
        ' exit on file not created
        Msgbox "The library " & install & " must be installed" & Chr( 10 ) _
        & "The file " & path & " couldn't be created" & Chr( 10 ) _
        & "Contact the administrator of this database"
        Exit Sub
    End If
    Print "Installed library " & install
End Sub

Function GetHelpAboutDocument( db As NotesDatabase ) As NotesDocument
    On Error Goto HandleError
    Goto EnterProc

HandleError:
    Error Err, Getthreadinfo( 1 ) & " : " & Erl & Chr$( 10 ) & Error$

EnterProc:

    Dim nc As NotesNoteCollection
    Set nc = db.CreateNoteCollection( False )
    nc.SelectHelpAbout = True
    Call nc.BuildCollection
    Dim nid As String
    nid = nc.GetFirstNoteId

    If nid <> "" Then
        Set GetHelpAboutDocument = db.GetDocumentByID( nid )
    Else
        Set GetHelpAboutDocument = Nothing
    End If
End Function

Sub ExtractAttachment( d As NotesDocument, filename As String, path As String )
    On Error Goto HandleError
    Goto EnterProc

HandleError:
    Error Err, Getthreadinfo( 1 ) & " : " & Erl & Chr$( 10 ) & Error$

EnterProc:

    If Not d.HasEmbedded Then Exit Sub

    Dim embedded As NotesEmbeddedObject
    Set embedded = d.GetAttachment( filename )
    If embedded Is Nothing Then Exit Sub

    Call embedded.ExtractFile( path )
End Sub
]]>
			http://noteslog.com/post/auto-install/feed/
		0
		
		
		
		http://noteslog.com/post/hacking-1-needed/
		http://noteslog.com/post/hacking-1-needed/#comments
		Sun, 25 Dec 2005 21:14:11 +0000
		Andrea Ercolino
				

		http://noteslog.com/?p=15
		
			In my apps I use many embedded views that show a single category. They are handy, but lack powerful features exposed views have. Sorting by a different column is one of them. 

Clearly it’s not a problem for embedded views as it is for categorized views. Notes cannot properly sort a categorized view by a different column, because the feature is poorly implemented in that case. 
So the hack should allow for a sorting that left the categorization in place. For backward compatibility, it could be a switchable feature, and the switch could be a special starting for the view comment, like “[1]“. 
]]>
			http://noteslog.com/post/hacking-1-needed/feed/
		0
		
		
		
		http://noteslog.com/post/regqueryvalue/
		http://noteslog.com/post/regqueryvalue/#comments
		Fri, 09 Dec 2005 23:33:52 +0000
		Andrea Ercolino
				

		http://noteslog.com/?p=14
		
			@RegQueryValue

Queries the Windows registry for a specified value.

(from @RegQueryValue, Notes Designer Help database)

Although this function can be used in LotusScript by means of an Evaluate, it doesn’t work at all for the registry (Default) values. So here is a LotusScript RegQueryValue full blown function, in its own RegistryAccess library.
'RegistryAccess:

Option Public
Option Declare

' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/registry_functions.asp
' http://www.windowsdevcenter.com/lpt/a/4923

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

%REM
LONG RegOpenKeyEx(
  HKEY hKey,
  LPCTSTR lpSubKey,
  DWORD ulOptions,
  REGSAM samDesired,
  PHKEY phkResult
);
%END REM
Declare Function RegOpenKeyEx _
Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
( Byval hKey As Long _
, Byval lpSubKey As String _
, Byval ulOptions As Long _
, Byval samDesired As Long _
, phkResult As Long ) _
As Long

%REM
LONG RegCloseKey(
  HKEY hKey
);
%END REM
Declare Function RegCloseKey _
Lib "advapi32.dll" _
( Byval hKey As Long ) _
As Long

%REM
LONG RegQueryValueEx(
  HKEY hKey,
  LPCTSTR lpValueName,
  LPDWORD lpReserved,
  LPDWORD lpType,
  LPBYTE lpData,
  LPDWORD lpcbData
);
%END REM
Declare Function RegQueryValueEx _
Lib "advapi32.dll" _
Alias "RegQueryValueExA" _
( Byval hKey As Long _
, Byval lpValueName As String _
, Byval lpReserved As Long _
, lpType As Long _
, Byval lpData As String _
, lpcbData As Long ) _
As Long

%REM
LONG RegEnumKeyEx(
  HKEY hKey,
  DWORD dwIndex,
  LPTSTR lpName,
  LPDWORD lpcName,
  LPDWORD lpReserved,
  LPTSTR lpClass,
  LPDWORD lpcClass,
  PFILETIME lpftLastWriteTime
);
%END REM
Declare Function RegEnumKeyEx _
Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
( Byval hKey As Long _
, Byval dwIndex As Long _
, Byval lpname As String _
, lpcbName As Long _
, Byval lpReserved As Long _
, Byval lpClass As String _
, lpcbClass As Long _
, lpftLastWriteTime As FILETIME ) _
As Long

%REM
LONG RegSetValueEx(
  HKEY hKey,
  LPCTSTR lpValueName,
  DWORD Reserved,
  DWORD dwType,
  const BYTE* lpData,
  DWORD cbData
);
%END REM
Declare Function RegSetValueEx _
Lib "advapi32.dll" _
Alias "RegSetValueExA" _
( Byval hKey As Long _
, Byval lpValueName As String _
, Byval Reserved As Long _
, Byval dwType As Long _
, Byval lpData As String _
, Byval cbData As Long ) _
As Long

%REM
LONG RegCreateKeyEx(
  HKEY hKey,
  LPCTSTR lpSubKey,
  DWORD Reserved,
  LPTSTR lpClass,
  DWORD dwOptions,
  REGSAM samDesired,
  LPSECURITY_ATTRIBUTES lpSecurityAttributes,
  PHKEY phkResult,
  LPDWORD lpdwDisposition
);
%END REM
Declare Function RegCreateKeyEx _
Lib "advapi32.dll" _
Alias "RegCreateKeyExA" _
( Byval hKey As Long _
, Byval lpSubKey As String _
, Byval Reserved As Long _
, Byval lpClass As String _
, Byval dwOptions As Long _
, Byval samDesired As Long _
, lpSecurityAttributes As SECURITY_ATTRIBUTES _
, phkResult As Long _
, lpdwDisposition As Long ) _
As Long

%REM
LONG RegQueryInfoKey(
  HKEY hKey,
  LPTSTR lpClass,
  LPDWORD lpcClass,
  LPDWORD lpReserved,
  LPDWORD lpcSubKeys,
  LPDWORD lpcMaxSubKeyLen,
  LPDWORD lpcMaxClassLen,
  LPDWORD lpcValues,
  LPDWORD lpcMaxValueNameLen,
  LPDWORD lpcMaxValueLen,
  LPDWORD lpcbSecurityDescriptor,
  PFILETIME lpftLastWriteTime
);
%END REM
Declare Function RegQueryInfoKey _
Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" _
( Byval hKey As Long _
, Byval lpClass As String _
, lpcbClass As Long _
, Byval lpReserved As Long _
, lpcSubKeys As Long _
, lpcbMaxSubKeyLen As Long _
, lpcbMaxClassLen As Long _
, lpcValues As Long _
, lpcbMaxValueNameLen As Long _
, lpcbMaxValueLen As Long _
, lpcbSecurityDescriptor As Long _
, lpftLastWriteTime As FILETIME ) _
As Long

Declare Function SHDeleteKey _
Lib "shlwapi.dll" _
Alias "SHDeleteKeyA" _
( Byval hKey As Long _
, Byval pszSubKey As String ) _
As Long

'-- Constant Definitions for WIN32API
Dim regKey List As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004

'Dim regError List As Long
Const ERROR_SUCCESS = 0&
Const ERROR_FILE_NOT_FOUND = 2&                  ' Registry path does not exist
Const ERROR_ACCESS_DENIED = 5&                   ' Requested permissions not available
Const ERROR_INVALID_HANDLE = 6&                  ' Invalid handle or top-level key
Const ERROR_BAD_NETPATH = 53&                    ' Network path not found
Const ERROR_INVALID_PARAMETER = 87&              ' Bad parameter to a Win32 API function
Const ERROR_CALL_NOT_IMPLEMENTED = 120&          ' Function valid only in WinNT/2000?XP
Const ERROR_INSUFFICIENT_BUFFER = 122&           ' Buffer too small to hold data
Const ERROR_BAD_PATHNAME = 161&                  ' Registry path does not exist
Const ERROR_NO_MORE_ITEMS = 259&                 ' Invalid enumerated value
Const ERROR_BADDB = 1009&                        ' Corrupted registry
Const ERROR_BADKEY = 1010&                       ' Invalid registry key
Const ERROR_CANTOPEN = 1011&                     ' Cannot open registry key
Const ERROR_CANTREAD = 1012&                     ' Cannot read from registry key
Const ERROR_CANTWRITE = 1013&                    ' Cannot write to registry key
Const ERROR_REGISTRY_RECOVERED = 1014&           ' Recovery of part of registry successful
Const ERROR_REGISTRY_CORRUPT = 1015&             ' Corrupted registry
Const ERROR_REGISTRY_IO_FAILED = 1016&           ' Input/output operation failed
Const ERROR_NOT_REGISTRY_FILE = 1017&            ' Input file not in registry file format
Const ERROR_KEY_DELETED = 1018&                  ' Key already deleted
Const ERROR_KEY_HAS_CHILDREN = 1020&             ' Key has subkeys & cannot be deleted

Const SYNCHRONIZE = &H100000

'Dim regStandard List As Long
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000

'Dim regAction List As Long
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_SET_VALUE = &H2
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = (KEY_READ)
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Const REG_OPTION_BACKUP_RESTORE = 4
Const REG_OPTION_NON_VOLATILE = 0
Const REG_OPTION_VOLATILE = 1
Const REG_CREATED_NEW_KEY = &H1                  ' A new key was created
Const REG_OPENED_EXISTING_KEY = &H2              ' An existing key was opened

' Reg Data Types...
Const RRF_RT_ANY = &H0000FFFF
Const REG_NONE = 0                               ' No value type
Const REG_SZ = 1                                 ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2                          ' Unicode nul terminated string
Const REG_BINARY = 3                             ' Free form binary
Const REG_DWORD = 4                              ' 32-bit number
Const REG_DWORD_LITTLE_ENDIAN = 4                ' 32-bit number (same as REG_DWORD)
Const REG_DWORD_BIG_ENDIAN = 5                   ' 32-bit number
Const REG_LINK = 6                               ' Symbolic Link (unicode)
Const REG_MULTI_SZ = 7                           ' Multiple Unicode strings

Function RegQueryValue( keyName As String, subKeyName As String, valueName As String ) As String
%INCLUDE "error_handling"

    Dim sKeyType As Long ' to return the key type
    Dim lpHKey As Long ' return handle to opened key
    Dim lpcbData As Long ' length of data in returned string

    Dim MainKey As Long
    MainKey = regKey( keyName )
    ' Open key
    If RegOpenKeyEx( MainKey, SubKeyName, 0&, KEY_READ, lpHKey ) <> ERROR_SUCCESS Then
        RegQueryValue = ""
        Exit Function ' No key open, so leave
    End If

    Dim lBuffer As Long
    lBuffer = 0
    ' Ask for buffer size for this value
    Call RegQueryValueEx( lpHKey, valueName, 0, sKeyType, 0, lBuffer )

    ' Initialize buffer
    Dim sBuffer As String
    sBuffer = Space( lBuffer ) & Chr( 0 )
    lBuffer = Len( sBuffer )
    If RegQueryValueEx( lpHKey, valueName, 0, sKeyType, sBuffer, lBuffer ) <> ERROR_SUCCESS Then
        RegQueryValue = ""   'Value probably doesn't exist
        Exit Function
    End If

    ' Trim returned buffer to extract key name
    sBuffer = Left( sBuffer, lBuffer - 1 )
    RegQueryValue = sBuffer

    ' Always close opened keys
    Call RegCloseKey( lpHKey )
End Function

Sub Initialize
%INCLUDE "error_handling"

    regKey( "HKEY_CLASSES_ROOT" ) = HKEY_CLASSES_ROOT
    regKey( "HKEY_CURRENT_CONFIG" ) = HKEY_CURRENT_CONFIG
    regKey( "HKEY_CURRENT_USER" ) = HKEY_CURRENT_USER
    regKey( "HKEY_LOCAL_MACHINE" ) = HKEY_LOCAL_MACHINE
    regKey( "HKEY_USERS" ) = HKEY_USERS
    regKey( "HKEY_PERFORMANCE_DATA" ) = HKEY_PERFORMANCE_DATA
End Sub

Sub Terminate

End Sub
 
]]>
			http://noteslog.com/post/regqueryvalue/feed/
		0