midrange.com code scratchpad
Name:
CLOB Locator procedures
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
02/13/2009 06:47:09 pm
IP:
Logged
Description:
The user was to lazy to give a description
Code:
  1.      /*=============================================================================================  
  2.      /*   Notes                                                                                       
  3.      /*=============================================================================================  
  4.                                                                                                       
  5.      /*   Compile with ACTGRP(XMS9001)                                                                
  6.                                                                                                       
  7.      /*=============================================================================================  
  8.      /*   Control Specifications                                                                      
  9.      /*=============================================================================================  
  10.                                                                                                       
  11.      H NoMain                                                                                         
  12.                                                                                                       
  13.      /*=============================================================================================  
  14.      /*   File Specifications                                                                         
  15.      /*=============================================================================================  
  16.                                                                                                       
  17.                                                                                                       
  18.      /*=============================================================================================  
  19.      /*   Prototype Specifications                                                                    
  20.      /*=============================================================================================  
  21.                                                                                                       
  22.                                                                                                       
  23.      /*=============================================================================================  
  24.      /*   Data Specifications                                                                         
  25.      /*=============================================================================================  
  26.                                                                                                       
  27.                                                                                                       
  28.      /*---------------------------------------------------------------------------------------------  
  29.      /*   Data Structure Specifications                                                               
  30.      /*---------------------------------------------------------------------------------------------  
  31.                                                                                                       
  32.       /Include QRPGCBSRC,STRING.H                                                                     
  33.       /Include QRPGCBSRC,MI_CPYBYTE                                                                   
  34.       /Include QRPGCBSRC,XMS9001                                                                      
  35.       /Include QRPGCBSRC,PVS9999                                                                      
  36.                                                                                                       
  37.      /*---------------------------------------------------------------------------------------------  
  38.      /*   Array Specifications                                                                        
  39.      /*---------------------------------------------------------------------------------------------  
  40.                                                                                                       
  41.                                                                                                       
  42.      /*---------------------------------------------------------------------------------------------  
  43.      /*   Indicator Specifications                                                                    
  44.      /*---------------------------------------------------------------------------------------------  
  45.                                                                                                       
  46.                                                                                                       
  47.      /*---------------------------------------------------------------------------------------------  
  48.      /*   Standalone Data Specifications                                                              
  49.      /*---------------------------------------------------------------------------------------------  
  50.                                                                                                       
  51.      D CLOBLocator     S                   SQLTYPE(CLOB_LOCATOR)                                      
  52.                                                                                                       
  53.      /*---------------------------------------------------------------------------------------------  
  54.      /*   Constant Specifications                                                                     
  55.      /*---------------------------------------------------------------------------------------------  
  56.                                                                                                       
  57.                                                                                                       
  58.      /*#############################################################################################  
  59.      /*   Procedure Deleclaration - Get String From CLOB                                              
  60.      /*#############################################################################################  
  61.                                                                                                       
  62.      P getStringFromCLob...                                                                           
  63.      P                 B                   Export                                                     
  64.                                                                                                       
  65.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  66.      /*   Procedure Interface                                                                         
  67.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  68.                                                                                                       
  69.      D getStringFromCLob...                                                                           
  70.      D                 PI            10I 0                                                            
  71.      D  string                         *   Value                                                      
  72.      D  stringLength                 10I 0 Value                                                      
  73.      D  clob                         10U 0 Value                                                      
  74.                                                                                                       
  75.      /*=============================================================================================  
  76.      /*   Procedure Data Specifications                                                               
  77.      /*=============================================================================================  
  78.                                                                                                       
  79.                                                                                                       
  80.      /*---------------------------------------------------------------------------------------------  
  81.      /*   Procedure Data Structure Specifications                                                     
  82.      /*---------------------------------------------------------------------------------------------  
  83.                                                                                                       
  84.                                                                                                       
  85.      /*---------------------------------------------------------------------------------------------  
  86.      /*   Procedure Array Specifications                                                              
  87.      /*---------------------------------------------------------------------------------------------  
  88.                                                                                                       
  89.                                                                                                       
  90.      /*---------------------------------------------------------------------------------------------  
  91.      /*   Procedure Indicator Specifications                                                          
  92.      /*---------------------------------------------------------------------------------------------  
  93.                                                                                                       
  94.                                                                                                       
  95.      /*---------------------------------------------------------------------------------------------  
  96.      /*   Procedure Standalone Data Specifications                                                    
  97.      /*---------------------------------------------------------------------------------------------  
  98.                                                                                                       
  99.      D clobString      S          32000A                                                              
  100.      D clobLength      S             10I 0                                                            
  101.                                                                                                       
  102.      D start           S             10I 0                                                            
  103.      D length          S             10I 0                                                            
  104.                                                                                                       
  105.      /*---------------------------------------------------------------------------------------------  
  106.      /*   Procedure Constant Specifications                                                           
  107.      /*---------------------------------------------------------------------------------------------  
  108.                                                                                                       
  109.      D nullTerminator...                                                                              
  110.      D                 S              1A   Inz(x'00')                                                 
  111.                                                                                                       
  112.      /*---------------------------------------------------------------------------------------------  
  113.      /*   Procedure Key Lists                                                                         
  114.      /*---------------------------------------------------------------------------------------------  
  115.                                                                                                       
  116.                                                                                                       
  117.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  118.      /*   Procedure Code                                                                              
  119.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  120.                                                                                                       
  121.      C/Exec SQL                                                                                       
  122.      C+ set option commit=*ALL                                                                        
  123.      C/End-Exec                                                                                       
  124.       /Free                                                                                           
  125.                                                                                                       
  126.        CLOBLocator = clob;                                                                            
  127.                                                                                                       
  128.        ExSr validateParms;                                                                            
  129.                                                                                                       
  130.        start = 1;                                                                                     
  131.        length = %Size(clobString);                                                                    
  132.                                                                                                       
  133.        DoW start < stringLength and                                                                   
  134.              start < clobLength;                                                                      
  135.                                                                                                       
  136.           If clobLength < start + length;                                                             
  137.              length = clobLength - start + 1;                                                         
  138.                                                                                                       
  139.           ElseIf stringLength < start + length;                                                       
  140.              length = stringLength - start + 1;                                                       
  141.           EndIf;                                                                                      
  142.                                                                                                       
  143.       /End-Free                                                                                       
  144.      C/Exec SQL                                                                                       
  145.      C+ values(substr(:CLOBLocator, :start, :length)) into :clobString                                
  146.      C/End-Exec                                                                                       
  147.       /Free                                                                                           
  148.                                                                                                       
  149.           sqlErrorTrap(sqlcod : 'Values' : 'Clob Locator' : sqlstt);                                  
  150.                                                                                                       
  151.           cpyBytes(string + start - 1 : %Addr(clobString) : length);                                  
  152.                                                                                                       
  153.           start += length;                                                                            
  154.        EndDo;                                                                                         
  155.                                                                                                       
  156.        If memcmp(string + (clobLength - 1): %Addr(nullTerminator) : 1) <> 0;                          
  157.           If clobLength < stringLength;                                                               
  158.              cpyBytes(string + clobLength : %Addr(nullTerminator) : 1);                               
  159.              clobLength += 1;                                                                         
  160.                                                                                                       
  161.           Else;                                                                                       
  162.              cpyBytes(string + (stringLength - 1) : %Addr(nullTerminator) : 1);                       
  163.           EndIf;                                                                                      
  164.        EndIf;                                                                                         
  165.                                                                                                       
  166.        Return clobLength;                                                                             
  167.                                                                                                       
  168.        //===========================================================================================  
  169.        //   Validate Parameters                                                                       
  170.        //===========================================================================================  
  171.                                                                                                       
  172.        BegSr validateParms;                                                                           
  173.                                                                                                       
  174.        //-------------------------------------------------------------------------------------------  
  175.        // String                                                                                      
  176.           If string = *NULL;                                                                          
  177.              Return -1;                                                                               
  178.           EndIf;                                                                                      
  179.                                                                                                       
  180.        //-------------------------------------------------------------------------------------------  
  181.        // String Length                                                                               
  182.           If stringLength < 1;                                                                        
  183.              Return -2;                                                                               
  184.           EndIf;                                                                                      
  185.                                                                                                       
  186.                                                                                                       
  187.        //-------------------------------------------------------------------------------------------  
  188.        // clob                                                                                        
  189.                                                                                                       
  190.       /End-Free                                                                                       
  191.      C/Exec SQL                                                                                       
  192.      C+ values(length(:CLOBLocator)) into :clobLength                                                 
  193.      C/End-Exec                                                                                       
  194.       /Free                                                                                           
  195.                                                                                                       
  196.           sqlErrorTrap(sqlcod : 'Values' : 'Clob Locator' : sqlstt);                                  
  197.                                                                                                       
  198.                                                                                                       
  199.           If clobLength = 0;                                                                          
  200.              cpyBytes(string : %Addr(nullTerminator) : 1);                                            
  201.              Return clobLength;                                                                       
  202.           EndIf;                                                                                      
  203.                                                                                                       
  204.        EndSr;                                                                                         
  205.                                                                                                       
  206.       /End-Free                                                                                       
  207.                                                                                                       
  208.      P getStringFromCLob...                                                                           
  209.      P                 E                                                                              
  210.                                                                                                       
  211.      /*#############################################################################################  
  212.      /*   Procedure Deleclaration - Put String Into CLOB                                              
  213.      /*#############################################################################################  
  214.                                                                                                       
  215.      P PutStringIntoCLob...                                                                           
  216.      P                 B                   Export                                                     
  217.                                                                                                       
  218.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  219.      /*   Procedure Interface                                                                         
  220.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  221.                                                                                                       
  222.      D putStringIntoCLob...                                                                           
  223.      D                 PI            10U 0                                                            
  224.      D  string                         *   Value                                                      
  225.      D  stringLength                 10I 0 Value                                                      
  226.      D  clob                         10U 0 Value                                                      
  227.                                                                                                       
  228.      /*=============================================================================================  
  229.      /*   Procedure Data Specifications                                                               
  230.      /*=============================================================================================  
  231.                                                                                                       
  232.                                                                                                       
  233.      /*---------------------------------------------------------------------------------------------  
  234.      /*   Procedure Data Structure Specifications                                                     
  235.      /*---------------------------------------------------------------------------------------------  
  236.                                                                                                       
  237.                                                                                                       
  238.      /*---------------------------------------------------------------------------------------------  
  239.      /*   Procedure Array Specifications                                                              
  240.      /*---------------------------------------------------------------------------------------------  
  241.                                                                                                       
  242.                                                                                                       
  243.      /*---------------------------------------------------------------------------------------------  
  244.      /*   Procedure Indicator Specifications                                                          
  245.      /*---------------------------------------------------------------------------------------------  
  246.                                                                                                       
  247.                                                                                                       
  248.      /*---------------------------------------------------------------------------------------------  
  249.      /*   Procedure Standalone Data Specifications                                                    
  250.      /*---------------------------------------------------------------------------------------------  
  251.                                                                                                       
  252.      D clobString      S          32000A                                                              
  253.      D clobLength      S             10I 0                                                            
  254.      D newstring       S               *                                                              
  255.                                                                                                       
  256.      D start           S             10I 0                                                            
  257.      D length          S             10I 0                                                            
  258.                                                                                                       
  259.      /*---------------------------------------------------------------------------------------------  
  260.      /*   Procedure Constant Specifications                                                           
  261.      /*---------------------------------------------------------------------------------------------  
  262.                                                                                                       
  263.      D nullTerminator...                                                                              
  264.      D                 S              1A   Inz(x'00')                                                 
  265.                                                                                                       
  266.      /*---------------------------------------------------------------------------------------------  
  267.      /*   Procedure Key Lists                                                                         
  268.      /*---------------------------------------------------------------------------------------------  
  269.                                                                                                       
  270.                                                                                                       
  271.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  272.      /*   Procedure Code                                                                              
  273.      /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  
  274.                                                                                                       
  275.       /Free                                                                                           
  276.                                                                                                       
  277.        ExSr validateParms;                                                                            
  278.                                                                                                       
  279.        CLOBLocator = clob;                                                                            
  280.                                                                                                       
  281.       /End-Free                                                                                       
  282.      C/Exec SQL                                                                                       
  283.      C+ set :CLOBLocator = ''                                                                         
  284.      C/End-Exec                                                                                       
  285.       /Free                                                                                           
  286.        sqlErrorTrap(sqlcod : 'Set' : 'Clob Locator' : sqlstt);                                        
  287.                                                                                                       
  288.        if memcmp(string + (stringLength - 1) : %Addr(nullTerminator) : 1) <> 0;                       
  289.           stringlength += 1;                                                                          
  290.           newstring = %alloc(stringlength);                                                           
  291.           cpybytes(newstring : string : stringlength - 1);                                            
  292.           memset(newstring + (stringlength - 1) : x'00' : 1);                                         
  293.        else;                                                                                          
  294.           newstring = %alloc(stringlength);                                                           
  295.           cpybytes(newstring : string : stringlength - 1);                                            
  296.        endIf;                                                                                         
  297.                                                                                                       
  298.        start = 0;                                                                                     
  299.        length = %Size(clobString);                                                                    
  300.        DoW start < stringLength;                                                                      
  301.                                                                                                       
  302.           If stringLength < start + length;                                                           
  303.              length = stringLength - start;                                                           
  304.           EndIf;                                                                                      
  305.                                                                                                       
  306.           cpyBytes(%Addr(clobString) : newstring + start : length);                                   
  307.                                                                                                       
  308.       /End-Free                                                                                       
  309.      C/Exec SQL                                                                                       
  310.      C+ set :CLOBLocator =                                                                            
  311.      C+       :CLOBLocator || clob(substr(:clobString, 1, :length))                                   
  312.      C/End-Exec                                                                                       
  313.       /Free                                                                                           
  314.           sqlErrorTrap(sqlcod : 'Set' : 'Clob Locator' : sqlstt);                                     
  315.                                                                                                       
  316.           start += length;                                                                            
  317.        EndDo;                                                                                         
  318.                                                                                                       
  319.        DeAlloc(ne) newstring;                                                                         
  320.                                                                                                       
  321.        Return clobLocator;                                                                            
  322.                                                                                                       
  323.        //===========================================================================================  
  324.        //   Validate Parameters                                                                       
  325.        //===========================================================================================  
  326.                                                                                                       
  327.        BegSr validateParms;                                                                           
  328.                                                                                                       
  329.        //-------------------------------------------------------------------------------------------  
  330.        // String                                                                                      
  331.           If string = *NULL;                                                                          
  332.              Return 0;                                                                                
  333.           EndIf;                                                                                      
  334.                                                                                                       
  335.        //-------------------------------------------------------------------------------------------  
  336.        // String Length                                                                               
  337.           If stringLength < 1;                                                                        
  338.              Return 0;                                                                                
  339.           EndIf;                                                                                      
  340.                                                                                                       
  341.        EndSr;                                                                                         
  342.                                                                                                       
  343.       /End-Free                                                                                       
  344.                                                                                                       
  345.      P putStringIntoCLob...                                                                           
  346.      P                 E                                                                              
  347.                                                                                                       
  348.        //===========================================================================================  
© 2004-2019 by midrange.com generated in 0.012s valid xhtml & css