home *** CD-ROM | disk | FTP | other *** search
/ Troubleshooting Netware Systems / CSTRIAL0196.BIN / attach / pcmag / v14n05 / ppv14n.exe / MAIN.BAS < prev    next >
BASIC Source File  |  1995-02-28  |  8KB  |  221 lines
  1. Rem CSMC Employee Directory RTF File Generator
  2. Rem Copyright (C) 1994-95 Ray Duncan
  3. Rem Version 1.0 12/1/94 derived from OMIM.MDB and GENEMAP.MDB
  4.  
  5. Option Compare Database   ' use database order for string comparisons
  6. Option Explicit           ' force declaration of all variables
  7.  
  8.  
  9. Function Main ()
  10.  
  11.   ' This is the main routine of the conversion program; it can be invoked 
  12.   ' with a command button or by running a macro. It generates several 
  13.   ' different sorted indexes of employee names, then generates a main 
  14.   ' file containing the detailed information about each employee.
  15.  
  16.   Call WriteIndexFile("CSMC Directory by Employee Name", "idx_name", "idxname.rtf", "EntireName", "LastName", 1.5)
  17.   Call WriteIndexFile("CSMC Directory by VAX Account", "idx_vax", "idxvax.rtf", "VaxMail1", "VaxMail1", 1.25)
  18.   Call WriteIndexFile("CSMC Directory by Extension", "idx_ext", "idxext.rtf", "Extension", "Extension", 1.5)
  19.   Call WriteIndexFile("CSMC Directory by Location", "idx_locn", "idxlocn.rtf", "Location", "Location", 1.5)
  20.   Call WriteIndexFile("CSMC Directory by Department", "idx_dept", "idxdept.rtf", "Dept", "Department", 3)
  21.   Call WriteBodyFile("csmcdir.rtf", "EntireName")
  22.  
  23. End Function
  24.  
  25.  
  26. Function Mcase (Sarg As Variant) As Variant
  27.   
  28.   ' Converts the argument string to mixed case if and only
  29.   ' if the string is in all caps. We use the "variant" form
  30.   ' of the string functions so that the routine won't crash
  31.   ' if it is passed a "null" string (as opposed to a
  32.   ' zero-length string).
  33.  
  34.   If StrComp(Sarg, UCase(Sarg), 0) <> 0 Then
  35.     Mcase = Sarg
  36.   Else
  37.     Mcase = UCase(Left(Sarg, 1)) & LCase(Mid(Sarg, 2))
  38.   End If
  39.  
  40. End Function
  41.  
  42.  
  43. Sub WriteBlankLine (FileNum As Integer)
  44.  
  45.   ' Generates the RTF code for a blank line. For
  46.   ' simplicity, this is just implemented as generation
  47.   ' of an empty paragraph.
  48.  
  49.   Print #FileNum, "\par"
  50.  
  51. End Sub
  52.  
  53.  
  54. Sub WriteBodyFile (FileName As String, IndexField As String)
  55.  
  56.   ' This routine builds the main RTF file for the employee
  57.   ' database. Each employee record in the database is converted
  58.   ' to an individual topic in the output file. The context
  59.   ' string and browse index for each topic is a function
  60.   ' of the number of the corresponding record in the database.
  61.   ' The employee last name is used for the keyword footnote.
  62.   ' The full employee name, with the last name first, is used
  63.   ' for the topic heading and for the title footnote (needed
  64.   ' for the history window).
  65.   
  66.   Dim Dbase As Database, Dset1 As Recordset
  67.   Dim TopicTitle As String, ContextString As String
  68.   Dim BrowseSequence As String, KeywordString As String
  69.  
  70.   ' open database and employee info table, set sort order
  71.   Set Dbase = DBEngine.Workspaces(0).Databases(0)
  72.   Set Dset1 = Dbase.OpenRecordset("CSMC Directory", DB_OPEN_TABLE)
  73.   Dset1.Index = IndexField
  74.   
  75.   ' open RTF output file, truncating any previous file
  76.   ' by the same name to zero length
  77.   Open FileName For Output As #1 Len = 4096
  78.  
  79.   ' write RTF file identifier, font table, and color table
  80.   Call EmitRTFHeader(1)
  81.  
  82.   ' now walk through the sorted recordset and write the detail records
  83.   While Dset1.EOF <> True
  84.   
  85.     ' Build topic title, browse sequence number, context string, and 
  86.     ' keyword string. Note: browse sequence & context string are 
  87.     ' synthesized from a counter field.
  88.     TopicTitle = (Mcase(Dset1![LastName]) & ", " & Mcase(Dset1![FirstName]))
  89.     BrowseSequence = "dir:" & Left$("00000", 6 - Len(Str$(Dset1![ID]))) & LTrim$(Str$(Dset1![ID]))
  90.     ContextString = "dir_" & LTrim$(Str$(Dset1![ID]))
  91.     KeywordString = Mcase(Dset1![LastName])
  92.  
  93.     ' write index topic header
  94.     Call EmitRTFTopicDivider(1, TopicTitle, ContextString, KeywordString, TopicTitle, BrowseSequence)
  95.  
  96.     ' set tab stop at 1"
  97.     Call EmitRTFTabStopInches(1, 1)
  98.  
  99.     ' turn off line wrap 
  100.     Print #1, "\keep "
  101.     
  102.     Call WriteBlankLine(1)
  103.     Call WriteBodyItem(1, "Credential", Dset1![Credential])
  104.     Call WriteBodyItem(1, "Title #1", Dset1![Title1])
  105.     Call WriteBodyItem(1, "Title #2", Dset1![Title2])
  106.     Call WriteBlankLine(1)
  107.     Call WriteBodyItem(1, "Department", Dset1![Department])
  108.     Call WriteBodyItem(1, "Division", Dset1![Division])
  109.     Call WriteBodyItem(1, "Location", Dset1![Location])
  110.     Call WriteBodyItem(1, "Mail Stop", Dset1![MailStop])
  111.     Call WriteBlankLine(1)
  112.     Call WriteBodyItem(1, "Extension", Dset1![Extension])
  113.     Call WriteBodyItem(1, "Dept. Ext.", Dset1![DeptExt])
  114.     Call WriteBodyItem(1, "FAX", Dset1![FAX])
  115.     Call WriteBodyItem(1, "Pager", Dset1![Pager])
  116.     Call WriteBodyItem(1, "VAXMail #1", Dset1![VaxMail1])
  117.     Call WriteBodyItem(1, "VAXMail #2", Dset1![VaxMail2])
  118.     Call WriteBlankLine(1)
  119.     Call WriteBodyItem(1, "Other Info", Dset1![Other])
  120.     Call WriteBlankLine(1)
  121.  
  122.     Dset1.MoveNext
  123.  
  124.   Wend
  125.   
  126.   ' write the RTF file terminators
  127.   Call EmitRTFTrailer(1)
  128.   
  129.   ' close the output file & recordset
  130.   Close #1
  131.   Dset1.Close
  132.  
  133. End Sub
  134.  
  135.  
  136. Sub WriteBodyItem (FileNum As Integer, ItemName As String, 
  137.                    ItemData As Variant)
  138.  
  139.   ' This handy little routine writes a field title, tabs to the
  140.   ' first tab stop, displays a detail item in boldface, and forces
  141.   ' the end of line.
  142.  
  143.   Print #FileNum, ItemName & ":\tab " & "{\b " & ItemData & "}"
  144.   Print #FileNum, "\par"
  145.  
  146. End Sub
  147.  
  148.  
  149. Sub WriteIndexFile (TopicTitle As String, ContextString As String, 
  150.                     FileName As String, IndexField As String, 
  151.                     InfoField As String, TabStop As Single)
  152.  
  153.   ' This routine writes a index to the employee file, consisting of
  154.   ' a list of hyperlinks and sorted on the specified database field,
  155.   ' to an RTF file as a single topic. The context string for the topic,
  156.   ' the name of the output file, and the distance to the first tab stop
  157.   ' are specified by the caller. The index sorted by employee name
  158.   ' gets some special handling to include the employee's extension,
  159.   ' since this is the index used most commonly.
  160.  
  161.   Dim Dbase As Database, Dset1 As Recordset
  162.   Dim HotLinkString As String, TargetString As String
  163.  
  164.   ' open database and employee info table, set sort order
  165.   Set Dbase = DBEngine.Workspaces(0).Databases(0)
  166.   Set Dset1 = Dbase.OpenRecordset("CSMC Directory", DB_OPEN_TABLE)
  167.   Dset1.Index = IndexField
  168.   
  169.   ' open RTF output file for sorted index
  170.   Open FileName For Output As #1 Len = 4096
  171.  
  172.   ' write RTF file identifier, font table, and color table
  173.   Call EmitRTFHeader(1)
  174.  
  175.   ' write index topic heading, but omit keyword and browse sequence
  176.   ' footnotes for index topics
  177.   Call EmitRTFTopicDivider(1, TopicTitle, ContextString, "", TopicTitle, "")
  178.  
  179.   ' set first tab stop as specified by caller
  180.   Call EmitRTFTabStopInches(1, TabStop)
  181.  
  182.   ' turn off line wrap for index entries
  183.   Print #1, "\keep \cf6"
  184.   
  185.   ' now walk through the sorted recordset and write the index topic
  186.   ' as a list of hyperlinks to the employee detail topics
  187.   While Dset1.EOF <> True
  188.  
  189.     TargetString = "dir_" & LTrim$(Str$(Dset1![ID]))
  190.     
  191.     ' skip records where the "InfoField" is empty or nonalphanumeric
  192.     If Dset1(InfoField) >= "0" Then
  193.  
  194.       ' adjust print format for the hotlink if we are sorting by name
  195.       If IndexField = "EntireName" Then
  196.     HotLinkString = Dset1![Extension] & "\tab " & Mcase(Dset1![LastName]) & ", " & Mcase(Dset1![FirstName])
  197.       Else
  198.     HotLinkString = Dset1(InfoField) & "\tab " & Mcase(Dset1![LastName]) & ", " & Mcase(Dset1![FirstName])
  199.       End If
  200.       
  201.       ' generate the hotlink and force end-of-line
  202.       Call EmitRTFHotLink(1, HotLinkString, TargetString)
  203.       Print #1, "\par"
  204.     
  205.     End If
  206.  
  207.     ' go to the next employee record
  208.     Dset1.MoveNext
  209.  
  210.   Wend
  211.   
  212.   ' write the RTF file terminators
  213.   Call EmitRTFTrailer(1)
  214.   
  215.   ' close the output file & recordset
  216.   Close #1
  217.   Dset1.Close
  218.  
  219. End Sub
  220.  
  221.