home *** CD-ROM | disk | FTP | other *** search
Wrap
'-------------------------------------------------------------------------- ' ' 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