PC World Komputer 1996 February/PCWK0296.iso/lwp95en/lotus013.dsk/LTSSL30.LSS

Text File | 1995-06-23 | 22KB | 773 lines

'--------------------------------------------------------------------------
'
'    File:         LTSSL30.LSS
'    Module:    Sample Function Libraries - Windows 3.1 interfaces
'    Created:    07/12/94
'
'    Copyright (c) 1994-95 Lotus Development Corporation
'
'    Description: This file contains the following sample
'        LotusScript Windows Functions:
'
'        GetTempDirectory
'        GetWinDirectory
'        WindowsHelp
'        GetProfInteger
'        GetProfString
'        WriteProfInteger
'        WriteProfString
'
'        AppClose
'        AppGetAppCount
'        AppGetAppNames
'        AppGetHWnd
'        AppGetWindowPos
'        AppHide
'        AppShow
'        AppIsRunning
'        AppIsVisible
'        AppMaximize
'        AppMinimize
'        AppMove
'        AppRestore
'        AppSize
'        AppSendMessage
'
'        FormatDate
'        DateDiff
'        Pause
'        ProperCase
'        Repeat
'        Str_Word
'        Log10
'
'    Disclaimer:
'        The sample LotusScript functions are provided
'        as code examples that provide useful functionality
'        to LotusScript programmers.  lotus makes no promise
'        or guarantee with respect to the use of these
'        functions.  Users can use the library at their own risk.
'
'--------------------------------------------------------------------------


'--------------------------------------------------------------------------
' External Function Declarations
'
' Rather than include a monster header file with every Windows function
' in it, we just take what we need.
'--------------------------------------------------------------------------

Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetProfileInt Lib "Kernel" (ByVal lpSection As String, ByVal lpEntry As String, ByVal nDefault As Integer) As Integer
Declare Function GetProfileString Lib "Kernel" (ByVal lpSection As String, ByVal lpEntry As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpSection As String, ByVal lpEntry As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
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 WriteProfileString Lib "Kernel" (ByVal lpSection As String, ByVal lpEntry As String, ByVal lpNewString As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpSection as String, ByVal lpEntry As String, ByVal lpNewString As String, ByVal lpFileName As String ) As Integer
Declare Function WinHelp Lib "User" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, dwData As Any) As Integer

public Const HELP_CONTENTS    = &H3    ' Display index.
public Const HELP_FORCEFILE    = &H9   ' Ensure that correct file is displayed.
public Const HELP_HELPONHELP    = &H4    ' Display "Using Help"
public Const HELP_QUIT        = &H2   ' Help no longer needed.

'--------------------------------------------------------------------------
' GetWinDirectory
'
' Returns the Directory in which Windows is installed.
'--------------------------------------------------------------------------

Public Function GetWinDirectory( ) as String

    Dim sBuffer as String * 256: sBuffer = string( 256, " " )

    GetWindowsDirectory sBuffer, 256

    GetWinDirectory = sBuffer

End Function

'--------------------------------------------------------------------------
' GetTempDirectory
'
' The temporary directory "TEMP" set in the environment variables.
' If this fails, it looks for "TMP".  If neither one is found, it returns
' an empty string.
'--------------------------------------------------------------------------

Public Function GetTempDirectory() as String

    Dim sTempBuffer as String

    sTempBuffer = Environ$( "TEMP" )

    If sTempBuffer = "" then
        sTempBuffer = Environ$ ( "TMP" )
    End If

    GetTempDirectory = sTempBuffer

End Function

'--------------------------------------------------------------------------
' WindowsHelp
'
' Brings up Windows Help with a given help file and context flags.
'--------------------------------------------------------------------------

Public Function WindowsHelp(HelpFile as String, HelpType as Integer ) as Long


   WindowsHelp = WinHelp(0, HelpFile, HelpType, 0 )

End Function

'--------------------------------------------------------------------------
' GetProfInteger
'
' Finds a value of the specified entry in the specified file.  If
' the entry is not found, the return value is set to zero.
'--------------------------------------------------------------------------

Public Function GetProfInteger(Section as String, Entry as String, Filename as String, DefaultValue as Integer) as Long

    Dim retval as Integer

    If filename = "" then
        retval = GetProfileInt(Section, Entry, DefaultValue)
    Else
        retval = GetPrivateProfileInt(Section, Entry, DefaultValue, Filename)
    End If

    GetProfInteger = retval

End Function

'--------------------------------------------------------------------------
' GetProfString
'
' This function returns a profile string from the specified ini file.
' If the filename passed is "", then the string will be searched for
' in the WIN.INI file
'--------------------------------------------------------------------------

Public Function GetProfString(Section as String, Entry as String, Filename as String, DString as String) as String

    Dim retstr as String*256
    Dim retval as Integer

    If filename = "" then
        retval = GetProfileString(Section, Entry, DString, retstr, 256)
   Else
        retval = GetPrivateProfileString(Section, Entry, DString, retstr, 256,Filename)
    End If

    GetProfString = Left$(retstr, retval)

End Function

'--------------------------------------------------------------------------
' WriteProfInteger
'--------------------------------------------------------------------------

Public Function WriteProfInteger(Section as String, Entry as String, Filename as String, NewValue as Integer) as Long

    Dim Strval as String
    Dim Errval as Integer
    Dim CurrChar as String

    Strval = CSTR(NewValue)

    If filename = "" then
        Errval = WriteProfileString(Section, Entry, Strval)
    Else
        Errval = WritePrivateProfileString(Section, Entry, Strval, Filename)
    End if

    WriteProfInteger = Errval

End Function

'--------------------------------------------------------------------------
' WriteProfString
'--------------------------------------------------------------------------

Public Function WriteProfString(Section as String, Entry as String, Filename as String, NewString as String ) as Long

    Dim Errval as Integer

    If filename = "" then
        Errval = WriteProfileString(Section, Entry, NewString)
    Else
        Errval = WritePrivateProfileString(Section, Entry, NewString, Filename)
    End If

    WriteProfString = Errval

End Function

option declare
option compare nocase

'--------------------------------------------------------------------------
' Windows functions/constants
'
' Culled from windows.h, rather than including the whole huge file.
'--------------------------------------------------------------------------

public Const GW_HWNDFIRST    = 0
public Const GW_HWNDLAST    = 1
public Const GW_HWNDNEXT    = 2
public Const GW_HWNDPREV    = 3
public Const GW_OWNER        = 4
public Const GW_CHILD         = 5

Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
Declare Function GetDesktopWindow Lib "User" () As Integer
Declare Function GetWindowText Lib "User" (ByVal hWnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
Declare Function GetNextWindow Lib "User" (ByVal hWnd As Integer, ByVal wFlag As Integer) As Integer
Declare Function IsWindowVisible Lib "User" (ByVal hWnd As Integer) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long

'------------------------------------------
' GetWindowRect
'------------------------------------------

Type RECT
    left As Integer
    top As Integer
    right As Integer
    bottom As Integer
End Type

Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)

'------------------------------------------
' ShowWindow
'------------------------------------------

public Const SW_HIDE                 = 0
public Const SW_NORMAL                 = 1
public Const SW_MAXIMIZE             = 3
public Const SW_SHOW                 = 5
public Const SW_MINIMIZE             = 6
public Const SW_RESTORE             = 9

Declare Function ShowWindow Lib "User" (ByVal hWnd As Integer, ByVal nCmdShow As Integer) As Integer

'------------------------------------------
' SetWindowPos
'------------------------------------------

public Const SWP_NOSIZE         = &H1
public Const SWP_NOMOVE         = &H2
public Const SWP_NOZORDER         = &H4

Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

'--------------------------------------------------------------------------
' AppClose
'
' Close a particular application
'--------------------------------------------------------------------------

public function AppClose(AppName as String) as Long

    on error goto handleit

    ActivateApp AppName
    SendKeys "%{F4}", TRUE
    AppClose = TRUE
    exit function

    handleit:
        AppClose = FALSE

end function

'--------------------------------------------------------------------------
' AppGetAppCount
'
' Return number of running Windows applications
'--------------------------------------------------------------------------

public function AppGetAppCount() as Long

    dim hWnd as Long
    dim namebuf as string*80
    dim textlen as Integer

    AppGetAppCount = 0
    hWnd = GetWindow(GetDesktopWindow(),GW_CHILD)

    do while hWnd <> 0

        textlen = GetWindowText(hWnd,namebuf,80)
        if textlen <> 0 then
            AppGetAppCount = AppGetAppCount + 1
        end if

        hWnd = GetNextWindow( hWnd, GW_HWNDNEXT )

    loop

end function

'--------------------------------------------------------------------------
' AppGetAppNames
'
' Fill an array with the names of the currently running applications.
'--------------------------------------------------------------------------

public function AppGetAppNames(AppList() as String, AppCount as Integer) as Integer

    dim hWnd as Long
    dim namebuf as String*80 ': namebuf = string(80," ")
    dim i as Integer : i = 0
    dim textlen as Integer

    redim AppList(AppCount)

    hWnd = GetWindow(GetDesktopWindow(),GW_CHILD)

    do while hWnd <> 0

        textlen = GetWindowText(hWnd,namebuf,80)

        if textlen <> 0 then
            AppList(i) = left$(namebuf,textlen) : i = i + 1
            if  i = AppCount then
                exit do
            end if
        end if

        hWnd = GetNextWindow( hWnd, GW_HWNDNEXT )

    loop

    AppGetAppNames = i

end function

'--------------------------------------------------------------------------
' AppGetHWnd
'
' Returns HWnd for a given window title
'--------------------------------------------------------------------------

public function AppGetHWnd(AppName as String) as Long

    dim hWnd as Long
    dim namebuf as String*80 ': namebuf = string(80," ")
    dim textlen as Integer

    AppGetHWnd = 0

    hWnd = GetWindow(GetDesktopWindow(), GW_CHILD)

    if hWnd = 0 then
        AppGetHWnd = 0
        exit function
    end if

    do while hWnd <> 0

        textlen = GetWindowText(hWnd,namebuf,80)
        if textlen <> 0 then
            if AppName = left$(namebuf,textlen) then
                AppGetHWnd = hWnd
                exit do
            end if
        end if

        hWnd = GetNextWindow( hWnd, GW_HWNDNEXT )

    loop

end function

'--------------------------------------------------------------------------
' AppGetWindowPos
'
' Get the coordinates and size of a window
'--------------------------------------------------------------------------

public function AppGetWindowPos(AppName as String, x as Integer, y as Integer, w as Integer, h as Integer) as Long

    dim hWnd as Long
    dim namebuf as string*80
    dim r as RECT

    hWnd = AppGetHWnd(AppName)

    if hWnd = 0 then
        AppGetWindowPos = FALSE
        exit function
    end if

    ' Window is valid, get rectange coordinates and compute width/height...

    call GetWindowRect(hWnd, r)

    x = r.left
    y = r.right
    w = r.right - r.left
    h = r.bottom - r.top
    AppGetWindowPos = TRUE

end function

'--------------------------------------------------------------------------
' SetWindowState (Private function)
'
' Set the state of a named window
'--------------------------------------------------------------------------

function SetWindowState(AppName as String, NewState as Integer) as Long

    dim hWnd as Long

    hWnd = AppGetHWnd(AppName)

    if hWnd = 0 then
        SetWindowState = FALSE
        exit function
    end if

    if ShowWindow(hWnd, NewState) = 0 then
        SetWindowState = TRUE  ' Previously visible
    else
        SetWindowState = FALSE ' Previously hidden
    end if

end function


'--------------------------------------------------------------------------
' AppHide
'
' Hides a window
'--------------------------------------------------------------------------

public function AppHide(AppName as String) as Long

    AppHide = SetWindowState(AppName, SW_HIDE)

end function

'--------------------------------------------------------------------------
' AppShow
'
' Shows a window
'--------------------------------------------------------------------------

public function AppShow(AppName as String) as Long

    AppShow = SetWindowState(AppName, SW_SHOW)

end function

'--------------------------------------------------------------------------
' AppIsRunning
'
' Return whether or not an application is running
'--------------------------------------------------------------------------

public function AppIsRunning(AppName as String) as Long

    if AppGetHWnd(AppName) <> 0 then
        AppIsRunning = TRUE
    else
        AppIsRunning = FALSE
    end if

end function

'--------------------------------------------------------------------------
' AppIsVisible
'
' Return whether or not an application is visible
'--------------------------------------------------------------------------

public function AppIsVisible(AppName as String) as Long

    dim hWnd as Long

    AppIsVisible = FALSE

    hWnd = AppGetHWnd(AppName)
    if hWnd <> 0 then
        if IsWindowVisible(hWnd) then
            AppIsVisible = TRUE
        end if
    end if

end function

'--------------------------------------------------------------------------
' AppMaximize
'
' Maximizes a window
'--------------------------------------------------------------------------

public function AppMaximize(AppName as String) as Long

    AppMaximize = SetWindowState(AppName, SW_MAXIMIZE)

end function

'--------------------------------------------------------------------------
' AppMinimize
'
' Minimizes a window
'--------------------------------------------------------------------------

public function AppMinimize(AppName as String) as Long

    AppMinimize = SetWindowState(AppName, SW_MINIMIZE)

end function

'--------------------------------------------------------------------------
' AppRestore
'
' Restore window to previous state
'--------------------------------------------------------------------------

public function AppRestore(AppName as String) as Long

    AppRestore = SetWindowState(AppName, SW_RESTORE)

end function

'--------------------------------------------------------------------------
' AppMove
'
' Move a window
'--------------------------------------------------------------------------

public function AppMove(AppName as String, x as Integer, y as Integer) as Long

    dim hWnd as Long

    hWnd = AppGetHWnd(AppName)

    if hWnd = 0 then
        AppMove = FALSE
        exit function
    end if

    AppMove = SetWindowPos(hWnd, 0, x, y, 0, 0, SWP_NOSIZE+SWP_NOZORDER)

end function

'--------------------------------------------------------------------------
' AppSize
'
' Resize a window
'--------------------------------------------------------------------------

public function AppSize(AppName as String, w as Integer, h as Integer) as Long

    dim hWnd as Long

    hWnd = AppGetHWnd(AppName)

    if hWnd = 0 then
        AppSize = FALSE
        exit function
    end if

    AppSize = SetWindowPos(hWnd, 0, 0, 0, w, h, SWP_NOMOVE+SWP_NOZORDER)

end function

'--------------------------------------------------------------------------
' AppSendMessage
'
' Send a Windows message to a window
'--------------------------------------------------------------------------

public function AppSendMessage(AppName as String, msg as Integer, wParam as Integer, lParam as Long) as Long

    dim hWnd as Long

    hWnd = AppGetHWnd(AppName)

    if hWnd = 0 then
        AppSendMessage = FALSE
        exit function
    end if

    AppSendMessage = SendMessage(hWnd, msg, wParam, lParam)

end function


'--------------------------------------------------------------------------
' FormatDate
'
' Formats date based on specified flag.
'--------------------------------------------------------------------------

Public Function FormatDate(d as variant, fmt as string) as string

    select case fmt

        case is="b":     FormatDate =    format$(d, "mmmm dd, yyyy")
        case is="B":     FormatDate =     ucase(format$(d, "mmmm dd, yyyy"))
        case is="c":     FormatDate =    format$(d, "dd mmmm yyyy")
        case is="C":    FormatDate =     ucase(format$(d, "dd mmmm yyyy"))
        case is="d":    FormatDate =    format$(d, "long date")
        case is="D":    FormatDate =    ucase(format$(d, "long date"))
        case is="e":    FormatDate =    format$(d, "mmmm dd")
        case is="E":    FormatDate =    ucase(format$(d, "mmmm dd"))
        case is="f":     FormatDate =    format$(d, "dddd dd")
        case is="F":    FormatDate =     ucase(format$(d, "dddd dd"))
        case is="g":    FormatDate =    format$(d, "mm/dd")
        case is="G":    FormatDate =    ucase(format$(d, "mm/dd"))
        case is="h":    FormatDate =    format$(d, "mm/dd/yyyy")
        case is="H":    FormatDate =    ucase(format$(d, "mm/dd/yyyy"))
        case is="i":     FormatDate =    format$(d, "dd, mmmm")
        case is="I":     FormatDate =    ucase(format$(d, "dd, mmmm"))
        case is="j":    FormatDate =    format$(d, "dd, mmmm yyyy")
        case is="J":    FormatDate =    ucase(format$(d, "dd, mmmm yyyy"))
        case is="k":    FormatDate =    format$(d, "yyyy mmmm dd")
        case is="K":    FormatDate =     ucase(format$(d, "yyyy mmmm dd"))
        case is="l":     FormatDate =    format$(d, "mmmm, dd")
        case is="L":    FormatDate =     ucase(format$(d, "mmmm, dd"))
        case else:        FormatDate =    ""
    end select

End function

'--------------------------------------------------------------------------
' DateDiff
'
' Returns an integer value that represents the number of days that
' separate the dates passed to the function
'--------------------------------------------------------------------------

Public Function DateDiff(date1 as Variant, date2 as Variant ) as Long

    Dim TempVal as Variant

    TempVal = CINT((DateValue(date1)) - (DateValue(date2)) )

    DateDiff = ABS(TempVal)

End Function

'--------------------------------------------------------------------------
' Pause
'
' Suspend execution of application for specified amount of time.
'--------------------------------------------------------------------------

Public Sub Pause( pausetime as Integer )

    Dim BeginTime as Single

    BeginTime = Timer

    Do While Timer < BeginTime + pausetime
        Yield
    loop

End Sub

'----------------------------------------------------------------------------
' ProperCase
'
' Capitalizes the first character, and lowercases the rest, of a string.
'----------------------------------------------------------------------------

Public Function ProperCase ( s as String ) as String

    Dim UpperIt as Integer : UpperIt = TRUE
    Dim newstring as string
    Dim currchar as string
    Dim i as Integer

    For i = 1 to len(s)
        currchar = mid(s,i,1)
        currchar = lcase$(currchar)
        If UpperIt then
            currchar = ucase$(currchar)
            UpperIt = FALSE
        End if
        If currchar = " " then
            UpperIt = TRUE
        End if
        newstring = newstring + currchar
    Next i

    ProperCase = newstring

End Function

'----------------------------------------------------------------------------
' Repeat
'
' Repeat a given pattern a certain number of times, up to a maximum length.
'----------------------------------------------------------------------------

Public Function Repeat(pattern as string, repcount as integer, maxlen as integer) as String

    Dim Newstring as String
   Dim i as Integer

    For i =  1 to repcount
        Newstring = Newstring + pattern
    Next i

    If maxlen <> 0 then ' in lieu of ommitted arguments...
        newstring = left$(newstring, maxlen)
    end if

    Repeat = newstring

End function

'----------------------------------------------------------------------------
' Str_Word
'
' Search for a given numbered repetition of a substring
'----------------------------------------------------------------------------

Public Function Str_Word(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

    Str_Word = mid$(searchstr,beginpos,endpos-beginpos)

End function

'----------------------------------------------------------------------------
' Log10
'
' Calculates the logarithm for a given number for the base of 10.
'----------------------------------------------------------------------------

Public Function Log10( inVal as Double) as Double

    Log10 = Log(inVal)/Log(10)

End function