OS/2 Shareware BBS: Product/Product.zip/visilotu.zip/TONOTES.PRG

Text File | 1995-12-21 | 17KB | 559 lines

!.HEADER
! ! Code generated  4-17-95 at 10:39 P.M.
! ! from WINDOW 'E:\visqdevt\LotNotes\visnote\ToNotes.wdw'
!
! ! Windows referred:-
! ! 'E:\visqdevt\LotNotes\visnote\ToNotes.wdw' established as main window
!.spec winsize MAX MAX
!.spec textcol 0 17
!.spec appdest 1 d:\visnotes\ToNotes.apl
!.HEADER
!
! DEFINITION
! Some ASL commands can be placed outside of the normal block
! structure. This block is provided to allow such commands to
! be accomodated
!
! Assign boolean variables
!
DECLARE TASK NUMERIC yes = 1
DECLARE TASK NUMERIC no  = 0
!
DECLARE TASK CHAR[4] ThisTask = A.System.ThisTask
!
! Open the library and declare the required functions
!
LIBRARY ASL "MyLib..AppDevL",
 App_Icon

!
! ON START
! This block is executed when the program is initially invoked.
! It is normally used to initialize variables needed during
! program execution and to open the main window of the
! application.
!
ON START(FileName, AppIdentifier, AppName)
DO


  ! Define Current Position
  g_CurLoc = A.System.StartDs'Location
  IF Split(g_CurLoc,Length(g_CurLoc),1) = "\"
    g_CurLoc = Split(g_CurLoc,1,Length(g_CurLoc)-1)


  !
  ! Open the object store holding the user library
  !
  OPEN OBJECTSTORE MyLib,
   NAME ="UserLib.A95",
   LOCATION = S.Control.Path

  OPEN SYSTEM Sys                                 ! establish connection with OS/2

  FORGIVE
  LET NotesPath = Sys'SEARCHPATH(                 ! locate the Notes directory
   "NOTES.EXE",                                   ! by searching for the Notes program file
   "PATH")                                        ! in the PATH setting of CONFIG.SYS
  IF A.System.ErrorNumber
  DO
    ERROR 1,"Unable to open LotusNotes Object. Check that Lotus Notes is installed." ||
            " correctly. The Lotus Notes directory must be in PATH and LIBPATH."
    STOP
  END


  LET NotesServer=""                              ! Notes Server name
  LET NotesDB=""                                  ! Notes databasename
  LET NotesForm = ""                              ! Notes Form name
  LET FieldName = ""                     ! Notes RichText field for Report/Chart output
  LET NotesDocumentId = ""                        ! Notes document id to update

  DEFINE ServerList[0]
  DEFINE DBList[0]
  DEFINE FormList[0]
  DEFINE FieldList[0]

  CALL Source_Define                              ! setup for drag/drop
  CALL Target_Define                              ! setup for drag/drop
  !
  OPEN WINDOW W_ToNotes,, "I.Windows.ToNotes",
   SOURCECTRL = POINTER(SourceCtrl[0]),
   TARGETCTRL = POINTER(TargetCtrl[0])

  LET DILText = "Connecting to Lotus Notes..."

  FORGIVE
    OPEN LOTUSNOTES Lotus

  IF Lotus'CODE > 0
  DO
    MESSAGE "FTB0003",0,Lotus'REASON
    SHUT Lotus
    STOP
  END

  LET DILText = "Connected to Lotus Notes"

  !
  CALL App_Icon(POINTER(W_ToNotes[0]))

  CALL Lotus'GetServerList( Pointer( ServerList[0] ) )

END

!
! ON SELECT
! This block is triggered whenever the user selects a control
! or menu entry.
!
ON SELECT
DO
  CASE A.System.Object
    !
    WHEN "T.W_ToNotes.DROPLIST1"
    DO
      MODIFY Lotus,
        SERVERNAME = ServerList[A.System.BoxNumber],
        DIRECTORY  = ""

      DEFINE Dirs[0]
      DEFINE DBList[0]
      DEFINE DBInfo[0]
      CALL Lotus'GetFileList( Pointer( Dirs[0] ), Pointer( DBList[0] ), Pointer( DBInfo[0] ) )

    END
    WHEN "T.W_ToNotes.DROPLIST2"
    DO

      MODIFY Lotus,
        DATABASE = DBList[A.System.BoxNumber]

      DEFINE FormList[0]
      CALL Lotus'GetFormList( Pointer( FormList[0] ) )

    END

    WHEN "T.W_ToNotes.DROPLIST3"
    DO

      MODIFY Lotus,
        FORMNAME = FormList[A.System.BoxNumber]

      DEFINE FieldList[0]              ! List for target field droplist
      DEFINE SFieldList[0]             ! List for Supplementary field droplists
      DEFINE FieldInfo[0]
      CALL Lotus'GetFormFieldList( Pointer( FieldList[0] ) , Pointer( FieldInfo[0]))
      COPY FieldList,SFieldList
      DO i = FieldList[0]'ENTRIES : 1,-1
        CASE FieldInfo[i]
          WHEN "RichText"              ! OK for main & supplementary targets
            NOTHING
          WHEN "Text"                  ! OK for supplementary field update,
          DO                           ! but not for main target field.
            DELETE FieldList[i]
            DELETE FieldInfo[i]
          END
          OTHERWISE                    ! Cannot update this field.
          DO
            DELETE FieldList[i]
            DELETE FieldInfo[i]
            DELETE SFieldList[i]
          END
        END
      END
      INSERT FieldList[1] = ""
      INSERT FieldInfo[1] = ""
      INSERT SFieldList[1] = ""
    END

  END

END
!
! ON DATA
! This block responds to controls which can accept data entry.
! It is executed whenever the cursor leaves the control after
! data has been changed. This is normally used to provide input
! validation.
!
ON DATA
DO
  CASE A.System.Object
    !
  END
END
!
! ON QUIT
! This block is executed when the user uses Close in the
! system menu.
! For a secondary window this would imply, 'shut the window'.
! For a primary window the implication is, 'close the
! Application'.
!
ON QUIT
DO
  CASE A.System.Object

    WHEN "T..W_ToNotes"                           ! primary window
      RUN PROGRAM ThisTask, STOP

    OTHERWISE
      SHUT ?A.System.Object

  END
END
!
! ON DESKTOP
! This block is signaled if the user modifies the window in any
! way, for example, resizing or using the maximize or minimize
! icons. Code here will take account of any such actions, for
! example, by resizing controls to account for a new window
! size.
!
ON DESKTOP
DO
  CASE A.System.Object
    WHEN "T..W_ToNotes"
    DO
      CASE A.System.Operation
        WHEN "MIN"
        DO
          !
        END
        !
        WHEN "NORM"
        DO
          !
        END
        !
        WHEN "SIZE"
        DO
          ! Respond to window sizing ( for example by
          ! repositioning or resizing controls )
        END
        !
      END
    END
  END
END
!
! ON SOURCE
! This event is signalled when there has been Direct Manipulation
! between this application and some other application.
! This applications Source window has been dropped onto a target
! window. The owner of the target window is asking for data about
! this application.
!
ON SOURCE(pStream)
DO
  DECLARE POINTER pStream
  !
  CASE (?pStream)'FORMAT
    !
    WHEN "IBMAPPLICATN"
    DO
      IF (?pStream)'REFERENCE
      DO
        OPEN REFERENCE Reference,
         SOURCETYPE = "FILE",
         NAME       = NAME(AppIdentifier),
         LOCATION   = LOCATION(AppIdentifier)

        CALL Reference'SAVE(pStream)
        SHUT Reference
      END
    END
    !
    ! Add code for any other formats here
    !
  END
  !
  CALL (?pStream)'FINISHED()
  SHUT(?pStream)
END
!
! This procedure sets up a SOURCECTRL object for direct manipulation and DDE
! actions.
!
PROCEDURE Source_Define
DO
  OPEN SOURCECTRL SourceCtrl,
   OBJECTNAME  = AppIdentifier,
   PRINTABLE   = 0,                               ! Can it be dragged to the printer?  If set the ON PRINT block is called
   DISCARDABLE = 0,                               ! Can it be dragged to the shredder? If Set the ON DISCARD block is called
   OPERATIONS  = "L"
  !
  CALL SourceCtrl'SETIMAGE("DLL", "FTBICONS<168>")
  CALL SourceCtrl'AddFormat("IBMAPPLICATN", 1)
  !
  ! Any other formats you wish to render should be added here.
  !
END
!
! Template for the ON TARGET block.
! This event is signalled when there has been Direct Manipulation
! between this application and some other application.
! This applications Source window has had an Icon dropped onto it
! from some other application. This application can now ask questions
! to find out what's been dropped, and take the appropriate action.
!
ON TARGET(pStream)
DO
  DECLARE POINTER pStream
  DECLARE CHAR[8] AppendOrReplace

  CALL W_ToNotes'FLUSH()               ! Make sure all data entry is detected.

  !
  IF T.W_ToNotes.REPLACE[0]'CHECKED = 1
    AppendOrReplace = "REPLACE"
  ELSE
    AppendOrReplace = "APPEND"

  DEFINE SuppFields[0]                 ! Names of supplementary fields to update
  DEFINE SuppValues[0]                 ! Values with which to update supplementary
                                       ! fields.
  IF \NOVALUE(SField1)                 ! If user specified a first supp. field
  DO
    INSERT SuppFields[0] = SField1
    INSERT SuppValues[0] = VALUE(SVal1,"")
  END
  IF \NOVALUE(SField2)                 ! If user specified a first supp. field
  DO
    INSERT SuppFields[0] = SField2
    INSERT SuppValues[0] = VALUE(SVal2,"")
  END

  CASE
    ! Add the formats you are accepting and what you want to do with them
    ! here.

    WHEN (?pStream)'FORMAT = "IBMREPORT"
    DO
      IF Valid_Parms()=No              ! check to ensure that all necessary
      DO                               ! parameters are entered
        ERROR 10002,"Please supply all necessary details.  (Document ID is the only "||
         "optional item.)"

        CALL (?pStream)'FINISHED()     ! shut the STREAM object
        SHUT ?pStream                  ! if all parms were not supplied

        RETURN                         ! return to Wait state
      END

      OutPutFile = String("_\REPORT.TXT",g_CurLoc)

      CALL Sys'INCLUDETEMP( OutPutFile )

      OPEN REFERENCE Reference         ! open a reference object and get the name
      CALL Reference'LOAD(pStream)     ! of the report dropped and passed via the stream

      OPEN IBMREPORT ThisReport,
       IDENTIFIER = FULLPATH(Reference'LOCATION,Reference'NAME)

      LET DILText = "Saving report to text file..."

      CALL ThisReport'COPYTO(OutputFile,"TEXT")

      CALL Lotus'StoreInNotes(
           FieldName,                  ! the name of the RichText field for the Report
           NotesDocumentId,            ! the Document to update (or empty to create a new one)
           OutputFile,                 ! the Report output file (must have extension of TXT)
           AppendOrReplace,
           POINTER(SuppFields[0]),     ! pointer to list of fields to update
           POINTER(SuppValues[0]) )    ! pointer to list of values to use

      IF Lotus'CODE = 0
        LET DILText = "Report saved in Notes database..."
      ELSE
        LET DILText = STRING("Error _ _ saving report in Notes database...",
         Lotus'CODE,Lotus'REASON)

      SHUT Reference                              ! shut the reference object

      SHUT ThisReport                             ! and then the Report

    END

    WHEN (?pStream)'FORMAT = "IBMCHART"
    DO
      IF Valid_Parms()=No                         ! check to ensure that all necessary
      DO                                          ! parameters are entered
        ERROR 10002,"Please supply all necessary details.  (Document ID is the only "||
         "optional item.)"

        CALL (?pStream)'FINISHED()                ! shut the STREAM object
        SHUT ?pStream                             ! if all parms were not supplied

        RETURN                                    ! return to Wait state
      END

      OutPutFile = String("_\CHART.PCX",g_CurLoc)
      CALL Sys'INCLUDETEMP( OutPutFile )

      OPEN REFERENCE Reference                    ! open a reference object and get the name
      CALL Reference'LOAD(pStream)                ! of the chart dropped and passed via the stream

      OPEN ?"IBMCHART" ThisChart,
       IDENTIFIER = FULLPATH(Reference'LOCATION,Reference'NAME)

      IF A.System.ErrorNumber
      DO
        ERROR 1,"The chart could not be opened, or Visualizer Charts has not "||
         "been installed."
        RETURN
      END

      LET DILText = "Saving chart to a graphics file..."

      CALL ThisChart'COPYTO(OutputFile,"PCX")

      CALL Lotus'StoreInNotes(
       FieldName,                        ! the name of the RichText field for the Chart
       NotesDocumentId,                  ! the Document to update (or empty to create a new one)
       OutputFile,                       ! the Chart output file (must have extension of PCX or BMP)
       AppendOrReplace,
       POINTER(SuppFields[0]),           ! pointer to list of fields to update
       POINTER(SuppValues[0]) )          ! pointer to list of values to use


      IF Lotus'CODE = 0
        LET DILText = "Chart saved in Notes database..."
      ELSE
        LET DILText = STRING("Error _ _ saving chart in Notes database...",
         Lotus'CODE,Lotus'REASON)

      SHUT Reference                              ! shut the reference object

      SHUT ThisChart                              ! and then the Chart

    END

    WHEN ( (?pStream)'FORMAT = "RTF" |
           (?pStream)'FORMAT = "TXT" |
           (?pStream)'FORMAT = "PCX"   )
    DO
      IF Valid_Parms()=No                         ! check to ensure that all necessary
      DO                                          ! parameters are entered
        ERROR 10002,"Please supply all necessary details.  (Document ID is the only "||
         "optional item.)"

        CALL (?pStream)'FINISHED()                ! shut the STREAM object
        SHUT ?pStream                             ! if all parms were not supplied

        RETURN                                    ! return to Wait state
      END

      OPEN REFERENCE Reference                    ! open a reference object and get the name
      CALL Reference'LOAD(pStream)                ! of the report dropped and passed via the stream

      InputFile = FULLPATH(Reference'LOCATION,Reference'NAME)

      CALL Lotus'StoreInNotes(
       FieldName,                        ! the name of the RichText field for the Chart
       NotesDocumentId,                  ! the Document to update (or empty to create a new one)
       InputFile,                        ! the file whose contents are to be stored
       AppendOrReplace,
       POINTER(SuppFields[0]),           ! pointer to list of fields to update
       POINTER(SuppValues[0]) )          ! pointer to list of values to use


      IF Lotus'CODE = 0
        LET DILText =
          STRING("^ saved in Notes database...",InputFile)
      ELSE
        LET DILText = STRING("Error: _1 _2",
         Lotus'CODE,Lotus'REASON)

      SHUT Reference
    END
  END

  CALL (?pStream)'FINISHED()                      ! shut the STREAM object
  SHUT ?pStream                                   ! that was passed to this block
END


!
! This procedure sets up a TARGETCTRL object for use by DDE and
! Direct Manipulation.
!
PROCEDURE Target_Define
DO
  OPEN TARGETCTRL TargetCtrl
  !
  ! Add any formats you wish to accept here.
  !

  CALL TargetCtrl'ADDFORMAT("IBMCHART","CML",1)   ! enable Charts to be dropped on our window
  CALL TargetCtrl'ADDFORMAT("IBMREPORT","CML",1)  ! enable Reports to be dropped on our window
  CALL TargetCtrl'ADDFORMAT("RTF","CML",1)        ! enable RTF files to be dropped on our window
  CALL TargetCtrl'ADDFMTEXT("RTF","RTF")
  CALL TargetCtrl'ADDFORMAT("PCX","CML",1)        ! enable PCX files to be dropped on our window
  CALL TargetCtrl'ADDFMTEXT("PCX","PCX")
  CALL TargetCtrl'ADDFORMAT("TXT","CML",1)        ! enable TXT files to be dropped on our window
  CALL TargetCtrl'ADDFMTEXT("TXT","TXT")
END
!
! ERROR event
! This block is executed when there is a run-time error.
! You can trap errors here or allow the error message provided
! to identify the error and stop the program.
!

ON ERROR
DO
  DECLARE CHAR[7] ans
  DECLARE NUMERIC i
  !
  ! Message to identify failing module and line
  !
  LET ans = DIALOG("FTB7004", 0,
   A.System.ErrorModule,
   A.System.ErrorLine)

  DO i = 1 : A.System.ErrorNumber[0]'ENTRIES
    IF ans = "CANCEL"
      TERMINATE
      !
      ! Display system message corresponding to error
      !
    LET ans = DIALOG ("FTB" || A.System.Errornumber[i], 0,
     A.System.ErrorInfo[i])
  END

  STOP
END
!
! ON STOP
! This block is executed when the program is terminated.
! You should use the block to carry out any housekeeping
! required before closing
!
ON STOP
DO
  LET DILText = "Disconnecting from Lotus Notes..."
  CALL W_ToNotes'REFRESH()

  SHUT Lotus
  !
  STOP
END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Valid_Parms
DO
  IF NOVALUE(NotesDB)=Yes |                       ! is the database name empty?
     NOVALUE(NotesForm)=Yes |                       ! is the Formname empty?
     NOVALUE(FieldName)=Yes                         ! is the RichTextField name empy?
    RETURN No                                     ! if so, then return a 0 (No)
  ELSE
    RETURN Yes                                    ! if not return a 1 (Yes)
END