IMPORTANT!

Snipt is going open source. We've toyed with this idea for quite a while, and have finally decided it's the right way to move forward.

A few things:
  • The entire Snipt source code will be released on GitHub under the 3-clause BSD License on Friday, September 10th.
  • While we'd like to think we're perfect, we realize we're only human. By open sourcing the software that runs this website, certain bugs or security flaws may be discovered that could compromise the privacy of your snipts.
  • Only the Lion Burger team will be able to push commits to the Snipt.net site. Contributors should send a pull request to add new features or submit patches.
  • By using this site, you agree not to be too angry or take any legal action against Lion Burger should this whole thing go up in flames some day.
  • Follow us on Twitter for updates.
I agree, close this message
Sign up to create your own snipts, or login.

Latest 100 public snipts » clarify The latest public clarify snipts.

showing 1-20 of 43 snipts for clarify
  • ∞ powershell script for querying cases and then writing output to excel 
    $strPath = "c:\temp\opencases.xls";

. .\DovetailCommonFunctions.ps1

$ClarifyApplication = create-clarify-application; 
$ClarifySession = create-clarify-session $ClarifyApplication; 

$dataSet = new-object FChoice.Foundation.Clarify.ClarifyDataSet($ClarifySession)
$caseGeneric = $dataSet.CreateGeneric("extactcase")
$caseGeneric.AppendFilter("status", "Equals", "Working")
$caseGeneric.AppendFilter("condition", "Equals", "Open")
$caseGeneric.Query()

$excel = New-Object -ComObject Excel.Application
$excel.Visible = $true
$workbook = $excel.Workbooks.add()
$sheet = $workbook.worksheets.Item(1)
$x = 1;

foreach( $case in $caseGeneric.Rows){
 $sheet.cells.item($x, 1) = $case["id_number"]
 $sheet.cells.item($x,2) = $case["title"]
 $x++
}

if(Test-Path $strPath)
  { 
   Remove-Item $strPath
   $excel.ActiveWorkbook.SaveAs($strPath)
  }
else
  {
   $excel.ActiveWorkbook.SaveAs($strPath)
  }

    copy | embed

    0 comments - tagged in  posted by gsherman on Nov 02, 2009 at 10:03 a.m. EST
  • ∞ Registry Key access Function 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                           
' Description     :  Registry Key access Function
'                                                                           
' Copyright (C)  2001 First Choice Software, Inc. All Rights Reserved                                         
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Directive Statements
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
OPTION EXPLICIT

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_ARENA_TRASHED = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
Const KEY_ALL_ACCESS = &H3F
Const REG_OPTION_NON_VOLATILE = 0
Const KEY_QUERY_VALUE = 1


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Type Declarations
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Global Variables
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Module Variables
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' External Prototypes
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Declare Public Function RegCloseKey Lib "advapi32.dll" _
    (ByVal hkey as Long) as Long


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

Declare Function RegQueryValueExString 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

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
    String, ByVal lpReserved As Long, lpType As Long, lpData As _
    Long, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
    String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
    As Long, lpcbData As Long) As Long


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Internal Prototypes
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Declare Public Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
       String, vValue As Variant) As Long
       
Declare Public Function QueryValue_lm(sKeyName As String, sValueName As String)_
    As String

Declare Public Function QueryValue_cu(sKeyName As String, sValueName As String)_
    As String




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Query Registry value of type HKEY_LOCAL_MACHINE
'
'   Use this function to retrieve an arbitrary key from HKEY_LOCAL_MACHINE
'
'   Function only enabled for strings and dwords
'
'   return values:      string containing data from key
'
'   input parameters:   sKeyName - string containg the name of the key
'                       sValueName - string containing the name of the
'                                   value to be queried. An empty string
'                                   will return the default value.
'
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function QueryValue_lm(sKeyName As String, sValueName As String) as String

Dim lRetVal     As Long         'result of the API functions
Dim hKey        As Long         'handle of opened key
Dim vValue      As Variant      'setting of queried value

    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)

                                    'vValue contains the registry value returned
    QueryValue_lm = CStr(vValue)
    lRetVal = RegCloseKey (hKey)
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Query Registry value of type HKEY_CURRENT_USER
'
'   Use this function to retrieve an arbitrary key from HKEY_CURRENT_USER
'
'   Function only enabled for strings and dwords
'
'   return values:      string containing data from key
'
'   input parameters:   sKeyName - string containg the name of the key
'                       sValueName - string containing the name of the
'                                   value to be queried. An empty string
'                                   will return the default value.
'
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function QueryValue_cu(sKeyName As String, sValueName As String) as String

Dim lRetVal     As Long         'result of the API functions
Dim hKey        As Long         'handle of opened key
Dim vValue      As Variant      'setting of queried value

    lRetVal = RegOpenKeyEx _
        (HKEY_CURRENT_USER, sKeyName, 0, KEY_QUERY_VALUE, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
                                    'vValue contains the registry value returned
    QueryValue_cu = CStr(vValue)
    lRetVal = RegCloseKey (hKey)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Query Value of type Ex
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
       String, vValue As Variant) As Long

Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

    On Error GoTo QueryValueExError

                            ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5
    Select Case lType
                                        ' For strings
    Case REG_SZ
        sValue = String(cch, 0)
        lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
        If lrc = ERROR_NONE Then
            vValue = Left$(sValue, cch - 1)
        Else
            vValue = Empty
        End If
                                        ' For DWORDS
        Case REG_DWORD
            lrc = RegQueryValueExLong _
                (lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then 
                vValue = lValue
            End If
        Case Else
                                        'all other data types not supported
            lrc = -1
        End Select

QueryValueExExit:
    QueryValueEx = lrc
    Exit Function

QueryValueExError:
    Resume QueryValueExExit
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:46 p.m. EDT
  • ∞ Get the Database Type. See if Oracle 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the Database Type. See if Oracle
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub get_if_db_is_oracle()
  Dim lstResult As New List             ' List returned from query
  
                                        ' Set up list and set error trap.
                                        ' Do the query. If no error, it's an
                                        '  oracle DB. Set that result and leave
  lstResult.ItemType = "sql_record"
  On Error Goto is_sql_db
  the_db.select "select table_name,column_name from all_tab_columns where TABLE_NAME = 'TABLE_CASE'", lstResult
  is_oracle = True
  oracle_suffix = "s"
  Goto end_of_func

                                        ' If this is a SQL Server/Sybase DB...
                                        '  Set that result, print out so that they
                                        '  know to ignore the previous statement.
is_sql_db:
  is_oracle = False
  oracle_suffix = ""
  Debug.Print "PLEASE IGNORE THE ERROR ON THE PREVIOUS LINE. It is just a test to see what database system you are using."

                                        ' Clear the error trap and exit
end_of_func:
  On Error Goto 0
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:44 p.m. EDT
  • ∞ Get the Clarify Schema Version 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the Clarify Schema Version
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function get_clarify_version() As Integer
  Dim lstResult As New List             ' List returned from query
  Dim recResult As adp_db_header_record ' The one UDT from query
  
                                        ' Set up list and do query
                                        ' Get the result
  lstResult.ItemType = "adp_db_header_record"
  the_db.Select "select schema_rev from adp_db_header", lstResult
  lstResult.GetItemByIndex 0, recResult    
  
                                        ' Return the revision
  get_clarify_version = recResult.schema_rev
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:44 p.m. EDT
  • ∞ Get the table number based on the name 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the table number based on the name
'
' Copyright (C) 1999. First Choice Software. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function get_tbl_name(tbl_num As Integer) As String
  Dim sql_stmt As String                ' SQL Statement string
  Dim t_list   As New List              ' List returned from query
  
                                        ' Set the return list type
                                        ' Create the sql stmt
                                        ' Execute it
  t_list.ItemType = "tbl_type"
  sql_stmt = "select type_name, comment" & oracle_suffix & _
             ", obj_group, type_id, type_flags from adp_tbl_name_map where " & _
             "type_id = " & Trim$(Str$(tbl_num))
  the_db.Select sql_stmt, t_list
  
                                        ' Get one return item from list
                                        ' Return target table number
  t_list.GetItemByIndex 0, a_tbl 
  get_tbl_name = Trim$(a_tbl.tbl_name)
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:43 p.m. EDT
  • ∞ Is it a Table (or View)? 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Is it a Table (or View)?
'
' Copyright (C) 1999. First Choice Software. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function is_table(tbl_num As Integer) As Boolean
  Dim sql_stmt As String                ' SQL Statement string
  Dim t_list   As New List              ' List returned from query

                                        ' Set the return list type
                                        ' Create the sql stmt
                                        ' Execute it
  t_list.ItemType = "tbl_type"
  sql_stmt = "select type_name, comment" & oracle_suffix & _
             ", obj_group, type_id, type_flags from adp_tbl_name_map where " & _
             "type_id = " & Trim$(Str$(tbl_num))
  the_db.Select sql_stmt, t_list

  
                                        ' Get one return item from list
                                        ' Return if it is a table
  t_list.GetItemByIndex 0, a_tbl 
  is_table = (a_tbl.the_flags And 512) = 0
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:43 p.m. EDT
  • ∞ Get Field Name From Table Num and Spec ID 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get Field Name From Table Num and Spec ID
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function get_field_name(tbl_num As Integer, spec_id As Integer) As String
  Dim sql_stmt As String                ' SQL to execute
  Dim ret_list As New List              ' Return list type
  Dim b_fld    As fld_type              ' Returned field object

                                        ' Build the sql statement to get the field name
                                        ' Execute the SQL  
  ret_list.ItemType = "fld_type"
  sql_stmt = "select field_name, fld_default, comment" & oracle_suffix & _
             ", type_id, flags, array_size, gen_field_id, spec_field_id, db_type " & _
             "from adp_sch_info where type_id = " & Trim$(Str$(tbl_num)) & " and spec_field_id = " & _
             Trim$(Str$(spec_id))
  the_db.Select sql_stmt, ret_list

                                        ' Get the record and the field. Return it.
  ret_list.GetItemByIndex 0, b_fld
  get_field_name = Trim$(b_fld.fld_name)
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:43 p.m. EDT
  • ∞ Get Users for RC Config 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get Users for RC Config
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub get_users(rc_config As String)
  Dim t_ret  As New BulkRetrieve        ' Structure to query the DB
  Dim t_list As List                    ' List returned from query
  Dim t_int  As Integer                 ' Looping integer
  Dim t_rec  As Record                  ' Each record returned
  
                                        ' Print the header
  print_line "assign_users", False, True
  Debug.Print "Extracting user/resource configuration information..."

                                        ' Get users for RC  
  t_ret.SimpleQuery 0, "rc_config"
  t_ret.AppendFilter 0, "name", cbEqual, rc_config
  t_ret.TraverseFromParent 1, "rc_config2user", 0
  t_ret.RetrieveRecords
  
                                        ' Get the list
                                        ' Loop through the user - print them out
  Set t_list = t_ret.GetRecordList(1)
  For t_int = 0 To t_list.Count - 1
    Set t_rec = t_list.ItemByIndex(t_int)
    print_line t_rec.GetField("login_name"), False, False
  Next t_int
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:42 p.m. EDT
  • ∞ Build the Name of an MTM Table 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Build the Name of an MTM Table
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function get_mtm_table_name(tbl1 As String, tbl1_num As Integer, _
                spec_rel1 As Integer, rel_name As String, inv_rel_name As String, _
                tbl2 As String) As String
  Dim tbl2_num As Integer               ' Table number for table 2
  Dim ret_list As New List              ' List returned from query
  Dim sql_stmt  As String               ' Sql statement

                   ' Get the table number for table 2  
  tbl2_num = get_tbl_num(tbl2)

                   ' Now get relation data for the inverse relation. We need to
                   '  know which spec_rel it is for building of the mtm table name
  ret_list.ItemType = "rel_type"
  sql_stmt = "select rel_name, target_name, inv_rel_name, comment" & oracle_suffix & _
             ", rel_phy_name, focus_fldname, focus_fldname, type_id, rel_type, rel_flags, spec_rel_id " & _
             "from adp_sch_rel_info where type_id = " & Trim$(Str$(get_tbl_num(tbl2))) & _
             " and rel_name = '" & inv_rel_name & "'"
  the_db.Select sql_stmt, ret_list
  ret_list.GetItemByIndex 0, a_rel2
  
  If tbl1_num <= tbl2_num Then
     get_mtm_table_name = "mtm_" & tbl1 & Trim$(Str$(spec_rel1)) & "_" & _
                          tbl2 & Trim$(Str$(a_rel2.spec_rel))
  Else
     get_mtm_table_name = "mtm_" & tbl2 & Trim$(Str$(a_rel2.spec_rel)) & "_" & _
                          tbl1 & Trim$(Str$(spec_rel1))
  End If
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:42 p.m. EDT
  • ∞ Get Unique Field For A View 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get Unique Field For A View
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function get_unique_field(view_num As Integer) As String
  Dim ret_list As New List              ' Return list from query
  Dim sql_stmt As String                ' SQL statement to perform

                                        ' Query for the unique field for the view
  ret_list.ItemType = "fld_type"
  sql_stmt = "select field_name, fld_default, comment" & oracle_suffix & _
             ", type_id, flags, array_size, gen_field_id, spec_field_id, db_type " & _
             "from adp_sch_info where type_id = " & Trim$(Str$(view_num)) & " and gen_field_id = 3"
  the_db.Select sql_stmt, ret_list

                                        ' If we find it, return it. If not, find the first field
                                        '  and assume it is the unique field
  If ret_list.Count = 1 Then
     ret_list.GetItemByIndex 0, a_fld
     get_unique_field = Trim$(a_fld.fld_name)
  Else
     ret_list.ItemType = "fld_type"
     sql_stmt = "select field_name, fld_default, comment" & oracle_suffix & _
                ", type_id, flags, array_size, gen_field_id, spec_field_id, db_type " & _
                "from adp_sch_info where type_id = " & Trim$(Str$(view_num)) & " and spec_field_id = 0"
     the_db.Select sql_stmt, ret_list
     ret_list.GetItemByIndex 0, a_fld
     get_unique_field = Trim$(a_fld.fld_name)
  End If
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:42 p.m. EDT
  • ∞ Get Info For a Field 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get Info For a Field
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub get_field_info(tbl_num As Integer, fld_name As String, fld_def As String, _
                          comment As String, the_flags As Integer, the_size As Integer, _
                          gen_fld As Integer, spec_fld As Integer, db_type As Integer)
  Dim ret_list As New List              ' Return list from query
  Dim sql_stmt As String                ' SQL statement to perform

                                        ' Query for a field in the table. If not found
                                        '  return that. Else, get the record and
                                        '  set the fields
  ret_list.ItemType = "fld_type"
  sql_stmt = "select field_name, fld_default, comment" & oracle_suffix & _
             ", type_id, flags, array_size, gen_field_id, spec_field_id, db_type " & _
             "from adp_sch_info where type_id = " & Trim$(Str$(tbl_num)) & " and field_name = '" & _
             fld_name & "'"
  the_db.Select sql_stmt, ret_list
  If ret_list.Count = 0 Then
     spec_fld = -1
     Exit Sub
  End If
  ret_list.GetItemByIndex 0, a_fld
  fld_def = Trim$(a_fld.fld_def)
  comment = Trim$(a_fld.comment)
  the_flags = a_fld.the_flags
  the_size = a_fld.the_size
  gen_fld = a_fld.gen_fld
  spec_fld = a_fld.spec_fld
  db_type = a_fld.db_type
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:41 p.m. EDT
  • ∞ Replace Spaces With Underlinesc 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Replace Spaces With Underlines
'
' Copyright (C) 2000. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function sp_to_under(in_str As String) As String
  Dim t_int   As Integer                ' Looping integer
  Dim out_str As String                 ' Output string  

                                        ' Loop through the string. For each
                                        '  character, if it is a string, change
                                        '  it into an underline. Else, leave 
                                        '  it along
  For t_int = 1 To Len(in_str)
    If Mid$(in_str, t_int, 1) <> SPACE Then
       out_str = out_str & Mid$(in_str, t_int, 1)
    Else
       out_str = out_str & UNDERLINE
    End If
  Next t_int
  
                                        ' Return the string
  sp_to_under = out_str
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:40 p.m. EDT
  • ∞ Parse a string into a list of words 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Parse a string into a list of words
'   Will use any delimiter passed in 'str_delim' as a delimiter
'   consecutive delimiters are treated as one
'   returns a list of strings in the lst_words parameter
'
'   Return Values:   0      success
'                   -1      empty string
'
'   Copyright (C)  1998 - 2001 First Choice Software, Inc.
'   All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function parse_string(str_input as String, str_delim as String, _
     int_count as Integer, lst_words as List) as Integer

Dim int_itemCnt as Integer 
Dim str_word as String
Dim i as Integer



    int_count = 0
    str_input = Trim$(str_input)
    int_itemCnt = ItemCount(str_input, str_delim)
    If Len(str_input) = 0 Then
        parse_string  = -1
    Else
        parse_string = 0
    End If
    
    For i = 1 to int_itemCnt
        str_word = Trim$(Item$(str_input, i, i, str_delim))
        lst_words.AppendItem str_word
        int_count = int_count + 1
    Next i

End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:40 p.m. EDT
  • ∞ Change a string to Name Case 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Change a string to Name Case (lower case with capitalized first letter)
'
' Copyright (C) 2001. First Choice Software. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function NCase(str_in as String) as String

    str_in = LCase$(str_in)
    NCase = UCase$(Left$(str_in, 1)) + Right(str_in, Len(str_in) - 1)

End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:40 p.m. EDT
  • ∞ Format Phone Numbers 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Format Phone Numbers
'
'   Format a text string into a US formatted phone number
'
' Copyright (C)  2000 First Choice Software, Inc. and Clarify, Inc.
' All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function format_phone(rawPhone as String) as String

Dim fString as String
Dim phoneLen as Integer
                                        ' NOTE: This fn formats phone numbers
                                        ' US style phone numbers: 10 digits +
                                        ' 4 digit extension. When operating
                                        ' outside the US and Canada, change this
                                        ' fn to match the format for that
                                        ' country.
                                        '
                                        ' Format is: (nnn) nnn-nnnn xnnnn
                                        ' 7 digit numbers are displayed as:
                                        ' nnn-nnnn
    rawPhone = Trim$(rawPhone)
    phoneLen = Len(rawPhone)
                                        ' if the number is less than 7 digits, 
                                        ' do not format
    If phoneLen < 7 Then
        format_phone = rawPhone
        Exit Function
    End If      
    
                                        ' if the string is not numeric, return
                                        ' as unformatted
    If NOT isNumeric(rawPhone) Then
        format_phone = rawPhone
        Exit Function
    End If
                                        ' if the number is less than 10 digits,
                                        ' return as nnn-nnnn xnn
    If phoneLen < 10 Then
        fString = Left$(rawPhone, 3) + "-" + Mid$(rawPhone, 4, 4)
        If phoneLen > 7 Then
            fString = fString + " x" + Right$(rawPhone, phoneLen - 7)
        End If

                                        ' the phone is 10 digits or more
                                        ' return as nnn-nnn-nnnn xnnnn
    Else
        fString = "(" + Left$(rawPhone, 3) + ") " + Mid$(rawPhone, 4, 3) + _
                "-" + Mid$(rawPhone, 7, 4)
        If phoneLen > 10 Then
            fString = fString + " x" + Right$(rawPhone, phoneLen - 10)
        End If

        
    End If
    
    format_phone = fString
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:39 p.m. EDT
  • ∞ delimit a string with a semi-colon 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   delimit a string with a semi-colon
'
' Copyright (C) 2001. First Choice Software. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub delimit(str_work as String)
Dim str_char as String
    str_char = Right$(Trim$(str_work), 1)
    If str_char = "," Then
        str_work = Left$(str_work, Len(str_work) - 1) + ";"
        Exit Sub
    End If
    If Len(str_work) > 0 AND str_char <> ";" Then
        str_work = str_work + "; "
    End If
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:39 p.m. EDT
  • ∞ Remove elements from the first list which appear in the second list 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function Description: Remove elements from the first list which 
'                       appear in the second list
'
' Copyright (C) 2000. First Choice Software. All Rights Reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub removeMatchingElements(lstMainList as List, lstRemoveElms as List)
Dim intIndex as Integer
Dim i as Integer

                                        ' traverese the list of elements to
                                        ' remove
                                        ' search the main list
                                        ' if the element exists on this list,
                                        ' remove it
    For i = 0 to lstRemoveElms.Count - 1
        intIndex = lstMainList.FindFirstIndex(lstRemoveElms.ItemByIndex(i))
        If intIndex > -1 Then
            lstMainList.RemoveByIndex intIndex
        End If
    Next i
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:38 p.m. EDT
  • ∞ copy a list of records to a new list 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' copy a list of records to a new list
'
' Copyright (C) 2001. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function copy_record_list(lst_in as List) as List
Dim lst_new as New List
Dim rec_new as Record
Dim rec_old as Record
Dim int_loop as Integer

    lst_new.ItemType = "record"
    For int_loop = 0 to lst_in.Count - 1
        Set rec_old = lst_in.ItemByIndex(int_loop)
        Set rec_new = rec_old.Copy
        lst_new.AppendItem rec_new
    Next int_loop
    Set copy_record_list = lst_new
End Function

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:38 p.m. EDT
  • ∞ Set a HGBST ELM query in a bulk retrieve 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Set a HGBST ELM query in a bulk retrieve
'
' Copyright (C) 1999. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub set_hgbst_elm(t_ret As BulkRetrieve, start_num As Integer, _
          list_name As String, elm_name As String)

                                        ' Find the specified list with the
                                        '  specified list name
                                        ' Find the related show list
                                        ' Find the related elements
                                        ' If an element name is specified,
                                        '  only find that one.
                                        ' Else, only find the default item 
                                        '  in the list
  t_ret.SimpleQuery start_num, "hgbst_lst"
  t_ret.AppendFilter start_num, "title", cbEqual, list_name
  t_ret.TraverseFromParent start_num + 1, "hgbst_lst2hgbst_show", start_num
  t_ret.TraverseFromParent start_num + 2, "hgbst_show2hgbst_elm", start_num + 1
  If Len(elm_name) = 0 Then
     t_ret.AppendFilter start_num + 2, "state", cbEqual, "Default"
  Else
     t_ret.AppendFilter start_num + 2, "title", cbEqual, elm_name
  End If
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:37 p.m. EDT
  • ∞ Set a GBST ELM query in a bulk retrieve 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Set a GBST ELM query in a bulk retrieve
'
' Copyright (C) 1999. First Choice Software, Inc. All Rights Reserved
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub set_gbst_elm(t_ret As BulkRetrieve, start_num As Integer, _
                 list_name As String, elm_name As String)

                                        ' Find the specified list with the
                                        '  specified list name
                                        ' Find the related elements
                                        ' If an element name is specified,
                                        '  only find that one.
                                        ' Else, only find the default item 
                                        '  in the list
  t_ret.SimpleQuery start_num, "gbst_lst"
  t_ret.AppendFilter start_num, "title", cbEqual, list_name
  t_ret.TraverseFromParent start_num + 1, "gbst_lst2gbst_elm", start_num
  If Len(elm_name) = 0 Then
     t_ret.AppendFilter start_num + 1, "state", cbEqual, 2
  Else
     t_ret.AppendFilter start_num + 1, "title", cbEqual, elm_name
  End If
End Sub

    copy | embed

    0 comments - tagged in  posted by gsherman on Apr 23, 2009 at 1:37 p.m. EDT
Sign up to create your own snipts, or login.