[an error occurred while processing this directive] [an error occurred while processing this directive]
Do you have source some source that you want to share? Is there some source that you want to see posted here?
If so, Contact Us and we'll be more than happy to help.
Cobol Source
Driver Program
Color Program Source
Add Timestamp in cols 73-80
Convert line to upper case
Convert line to lower case
Add comment line
Remove comment line
CL Source
Color Source
Color Source Code (CMD)
Sample FTP Batch Processing
Get the device IP address
Verify IP Address with Ping
Set Library List with Job Description
Start My remote Printer (LPD)
Telnet Initialize program
Telnet Terminate program
DDS Source
Display a calendar window - DSPF
Color source code
DDS Functionality - AFPDS Examples
DDS to be used for external DS for DBF
DDS to be used for external DS for DSPF
DDS to be used for external DS for PRTF
DDS to be used for external DS for RPG
Display a calendar window - PF
Subfile Skeleton Display File
RPGLE Source
Display a calendar window
Color Souce code
1 EVAL statement to return the day of the week
Date Routine
Date and Time Subprocedures
DDS Functionality - AFPDS Examples
Convert Character to Numeric
Day of Week, Name of Month and Day
Standard HTTP Subprocedures (QTMHCGI)
Standard HTTP Supprocedures (QZHBCGI)
Library List Subprocedures
Replace Characters in String
String Functions
User Space Function Procedures
Copy Member for User Space Prototypes
Hello World Sample CGI Program using RPG
Increment a Character
Socket Program - Main
Subfile Skeleton Program
Socket Program - Submitted
Get and Put Spooled File API Example
      ****************************************************************
      *  Description.. Standard String Functions                     *
      *  Program Name. F.STRING                                      *
      *  Author....... Bradley V. Stone                              *
      *                BVS/Tools - www.bvstools.com                  *
      *                                                              *
      ****************************************************************
     H NOMAIN
      ****************************************************************
      * Prototypes                                                   *
      ****************************************************************
     D #ZChar          PR           256                                         Zero Supress Char
     D   text                       256    VALUE
     D   size                         3  0 VALUE
      *
     D #Replace        PR          1024                                         Replace Characters
     D  InString                   1024    VALUE
     D  From                         56    VALUE
     D  To                           56    VALUE
      *
     D #Len            PR             5  0                                      Length of String
     D  InString                   1024    VALUE
      *
     D #CtoN           PR            30P 9                                      Character to Numeric
     D   String                      32    VALUE
      *
     D #ToUpper        PR          1024
     D  InString                   1024    VALUE
      *
     D #ToLower        PR          1024
     D  InString                   1024    VALUE
      ****************************************************************
      * Global Definitions                                           *
      ****************************************************************
     D Up              C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     D Low             C                   'abcdefghijklmnopqrstuvwxyz'
      *//////////////////////////////////////////////////////////////*
      * (#ZChar) Zero Supress A Character Field                      *
      *//////////////////////////////////////////////////////////////*
     P #ZChar          B                   EXPORT
      *--------------------------------------------------------------*
     D #ZChar          PI           256
     D  text                        256    VALUE
     D  size                          3  0 VALUE
      *
     D textout         S            256
     D l               S              3  0
      *--------------------------------------------------------------*
     C     '0'           CHECK     text          l
      *
     C                   if        (l <= size) and (l > 0)
     C                   eval      textout =
     C                             %subst(text:l:(size-l)+1)
     C                   else
     C                   eval      textout = '0'
     C                   endif
      *
     C                   RETURN    textout
      *--------------------------------------------------------------*
     P #ZChar          E
      *//////////////////////////////////////////////////////////////*
      * (#Replace) Replace character(s) with new character(s)        *
      *//////////////////////////////////////////////////////////////*
     P #Replace        B                   EXPORT
      *--------------------------------------------------------------*
     D #Replace        PI          1024
     D  InString                   1024    VALUE
     D  From                         56    VALUE
     D  To                           56    VALUE
      *
     D String          S           1024
     D Temp            S           1024
     D i               S              4  0
     D j               S              4  0
     D len             S              4  0
     D lenTo           S              4  0
      *--------------------------------------------------------------*
     C                   eval      String = InString
     C                   eval      i = 1
     C     ' '           CHECKR    From          len                      99
      *
     C                   if        (not *IN99)
     C                   eval      len = %size(From)
     C                   endif
      *
     C     ' '           CHECKR    To            lenTo                    99
      *
     C                   if        (not *IN99)
     C                   eval      lenTo = %size(To)
     C                   endif
      *
     C     From:len      SCAN      String:i      j
      *
     C                   dow       (j <> 0)
     C                   eval      Temp = %trim(To) + %subst(String:j+len)
      *
     C                   if        (j = 1)
     C                   eval      String = Temp
     C                   else
     C                   eval      String = %subst(String:1:j-1) + Temp
     C                   endif
      *
     C                   eval      i = (j + lenTo)
     C     From:len      SCAN      String:i      j
     C                   enddo
     C                   RETURN    String
      *--------------------------------------------------------------*
     C     *PSSR         BEGSR
     C                   RETURN    InString
     C                   ENDSR
      *--------------------------------------------------------------*
     P #Replace        E
      *//////////////////////////////////////////////////////////////*
      * (#Len) Return Length of String                               *
      *//////////////////////////////////////////////////////////////*
     P #Len            B                   EXPORT
      *--------------------------------------------------------------*
     D #Len            PI             5  0
     D  InString                   1024    VALUE
      *
     D Len             S              5  0
      *--------------------------------------------------------------*
     C     ' '           CHECKR    InString      Len                      99
      *
     C                   if        (not *IN99)
     C                   eval      Len = %size(InString)
     C                   endif
      *
     C                   RETURN    Len
      *--------------------------------------------------------------*
     P #Len            E
      *//////////////////////////////////////////////////////////////*
      * (#CtoN) Character to Numeric                                 *
      *//////////////////////////////////////////////////////////////*
     P #CtoN           B                   EXPORT
      *--------------------------------------------------------------*
     D #CtoN           PI            30P 9
     D  Char                         32    VALUE
      *
     D                 DS
     D Char1                          1
     D Num1                           1  0 OVERLAY(Char1) INZ
      *
     D Num             S             30P 9
     D WrkNum          S             30P 0
     D Sign            S              1  0 INZ(1)
     D DecPos          S              3  0
     D Decimal         S              1    INZ('N')
     D i               S              4  0
     D j               S              4  0
      *--------------------------------------------------------------*
     C                   eval      Char = %triml(Char)
     C     ' '           CHECKR    Char          j                        99
      *
     C                   if        (not *IN99)
     C                   eval      j = %size(Char)
     C                   endif
      *
     C     1             do        j             i
     C                   eval      Char1 = %subst(Char:i:1)
      *
     C                   select
     C                   when      (Char1 = '-')
     C                   eval      Sign = -1
     C                   when      (Char1 = '.')
     C                   eval      Decimal = 'Y'
     C                   when      (Char1 >= '0') and (Char1 <= '9')
     C                   eval      WrkNum = (WrkNum * 10 + Num1)
      *
     C                   if        (Decimal = 'Y')
     C                   eval      DecPos = (DecPos + 1)
     C                   endif
      *
     C                   endsl
      *
     C                   enddo
      *
     C                   eval(h)   Num = (WrkNum * Sign / (10 ** DecPos))
     C                   RETURN    Num
      *--------------------------------------------------------------*
     C     *PSSR         BEGSR
     C                   RETURN    0
     C                   ENDSR
      *--------------------------------------------------------------*
     P #CtoN           E
      *//////////////////////////////////////////////////////////////*
      * (#ToUpper) Convert to Upper Case                             *
      *//////////////////////////////////////////////////////////////*
     P #ToUpper        B                   EXPORT
      *--------------------------------------------------------------*
     D #ToUpper        PI          1024
     D  InString                   1024    VALUE
      *
     D OutString       S           1024
      *--------------------------------------------------------------*
     C     Low:Up        XLATE     InString      OutString
      *
     C                   RETURN    OutString
      *--------------------------------------------------------------*
     P #ToUpper        E
      *//////////////////////////////////////////////////////////////*
      * (#ToLower) Convert to Lower Case                             *
      *//////////////////////////////////////////////////////////////*
     P #ToLower        B                   EXPORT
      *--------------------------------------------------------------*
     D #ToLower        PI          1024
     D  InString                   1024    VALUE
      *
     D OutString       S           1024
      *--------------------------------------------------------------*
     C     Up:Low        XLATE     InString      OutString
      *
     C                   RETURN    OutString
      *--------------------------------------------------------------*
     P #ToLower        E
[an error occurred while processing this directive]