H CopyRight('........ (c) - 2006')
H DatEdit(*YMD.)
H Option( *SrcStmt: *NoDebugIO)
H DECEDIT(*JOBRUN)
H BndDir('QC2LE')
//*=============================================================
//*
//* Function :‚SQL - like and soundex search
//*
//* ------------------------------------------------------------
//* Created:
//* Programmer:‚Jan Jorgensen
//* Date . . :‚2007-02-08
//*
//* How to compile:
//*
//* step 1
//* CRTRPGMOD MODULE(yourlib/form012a) SRCFILE(yourlib/QRPGSRC)
//* SRCMBR(form012a) DBGVIEW(*SOURCE) REPLACE(*YES)
//*
//* step 2
//* CRTPGM PGM(yourlib/form012a) MODULE(form012a)
//* BNDSRVPGM(QHTTPSVR/QZHBCGI)
//*
//*=============================================================
//==============================================================
//‚ DECLARE WORK FIELDS, ARRAYS AND MORE
//==============================================================
// Contants
D HTTPHeader c Const('Content-type: text/html')
D NewLine c Const(X'15')
D IFSfile c 'form012ah.htm'
D IFSpath c '/your-root-dir/mcpressonline/likesoundex'
D link s 1000a
D dsarrNames ds Inz
D arrNames 30 dim(100)
D dsarrValues ds Inz
D arrValues 60 dim(100)
D varCount 5i 0 inz(0)
D FormName s 30 DIM(1) PERRCD(1)
D CTDATA
D NbrNam s 5i 0 inz( %elem( FormName ))
D wrkFormName s like( FormName )
D SndHTMLmsg s n
D zSearchCity s like( CITY )
D SwapColor s n inz( *ON )
D RowBgColor s 7a
D BgColor1 s 7a inz('#e8e8e8')
D BgColor2 s 7a inz('#ffffff')
D i s 5i 0 Inz( *Zeros )
D j s 5i 0 Inz( *Zeros )
D Rslt s 5i 0 Inz( *Zeros )
D Lng s 5i 0 Inz( *Zeros )
D WrkLine s 2000 varying
D WrkTarg s 2000 varying
D q C ''''
D LF C x'25'
D file s *
D space s 113A
D line s 112A varying
D p_data s *
D fd S 10I 0
D wrdata S 24A
D rddata S 48A
D flags S 10U 0
D mode S 10U 0
D Msg S 50A
D Len S 10I 0
D data s 50A
D wait s 1A
*----------------------------------------------------------------
* SQL data
*----------------------------------------------------------------
D SqlFile E DS EXTNAME( WWWUSZIP )
D SQL_NUM c 10
//----------------------------------------------------------------
// Prototypes
//----------------------------------------------------------------
// IFS prototypes - Made by Scott Klement (http://www.scottklement.com)
/copy qrpgsrc,bufio_h
// MakeHTML function
D MakeHTML pr
D StringIn 2000 value
// Replace function
D ReplaceIt pr 2000a
D Target 2000 const
D Source 2000 value
D StartPos 5i 0 const
D Length 5i 0 const
// Parse
D CGIparse pr ExtPgm('CGIPARSEZ')
D pArrNames like( arrNames )
D pArrValues like( arrValues )
D pVarCount like( varCount )
//==============================================================
//‚Main Loop
//==============================================================
/free
//---------------------------------------------------------------
// Tell browser HTML is coming
//---------------------------------------------------------------
// Content-Type
MakeHTML( HTTPHeader + NewLine + NewLine );
//---------------------------------------------------------------
// Init program...
//---------------------------------------------------------------
// Set Error checker
SndHTMLmsg = *OFF;
//---------------------------------------------------------------
// Read standard input
//---------------------------------------------------------------
ExSr subrFORMparse;
//---------------------------------------------------------------
// Move html values to internal fields
//---------------------------------------------------------------
ExSr subrParseFields;
//---------------------------------------------------------------
// Display form
//---------------------------------------------------------------
ExSr subrCreateHTMLreply;
//---------------------------------------------------------------
// Stop Program
//---------------------------------------------------------------
ExSr StopPgm;
//---------------------------------------------------------------
// Parse HTML form
//---------------------------------------------------------------
BegSr subrFORMparse;
CallP(e) CGIparse( dsarrNames
: dsarrValues
: varCount
)
;
EndSr;
//---------------------------------------------------------------
// Parse fields to the correct internal RPG fields
//---------------------------------------------------------------
BegSr subrParseFields;
// Search fields
For i = 1 BY 1 TO NbrNam;
// No more fields
If FormName(i) = '*none';
Leave;
EndIf;
wrkFormName = FormName(i);
j = 1;
// Find the fields to parse to
j = %lookup( wrkFormName: arrNames : 1 );
If j>0;
*in30 = *on;
Else;
*in30 = *off;
Endif;
If *in30;
Select;
// Search string
When wrkFormName = FormName(1);
zSearchCity = arrValues(j);
EndSl;
EndIf;
EndFor;
EndSr;
//================================================================
// Create HTML reply
//================================================================
BegSr subrCreateHTMLreply;
file = fopen( IFSpath + '/' + IFSfile : 'r');
// IFS file not found
if (file = *NULL);
MakeHTML( 'ERROR - Skeleton file not found : '
+ IFSpath
+ '/'
+ IFSfile
+ NewLine
);
ExSr StopPgm;
endif;
dou 1 = 2;
// Read data
p_data = fgets( %addr(space): %size(space): file );
// End of file
if ( p_data = *NULL ) ;
leave ;
endif ;
// Move data read into an internal field
line = %str(p_data);
// Remove linebreak if any
If (%subst(line:%len(line):1) = LF);
%len(line) = %len(line) - 1;
Endif;
If line > *BLANKS;
WrkLine = line;
//---------------------------------------------------------------
// Insert data
//---------------------------------------------------------------
Rslt = %scan('%%detaildata%%' : WrkLine: 1 );
If Rslt > *Zeros;
Lng = %size( '%%detaildata%%' );
//---------------------------------------------------------------
// Get data
//---------------------------------------------------------------
ExSr SubrGetCities;
Iter;
EndIf;
//---------------------------------------------------------------
// Write HTML to browser
//---------------------------------------------------------------
MakeHTML( %trim(WrkLine) + NewLine );
EndIf;
EndDo;
//-------------------------------------------------------------
// Close IFS file
//-------------------------------------------------------------
fclose(file);
EndSr;
//---------------------------------------------------------------
// Make soundex search
//---------------------------------------------------------------
BegSr SubrGetCities;
/end-free
C eval i = 0
* Describe sql data area.
C/exec sql
C+ include sqlda
C/end-exec
C/Exec SQL
C+
C+ declare c1
C+ cursor for
C+ select *
C+ from your-data-lib/WWWUSZIP
C+ where city = :zSearchCity
C+ for fetch only
C+
C/End-exec
C/Exec SQL
C+ open c1
C/End-exec
C DOW 1 = 1
C/Exec SQL
C+ fetch c1
C+ into : sqlfile
C/End-exec
C If SqlCod <> 0
C Leave
C EndIf
* Build HTML line and write to browser
C ExSr SubrBuildLine
C EndDo
C/Exec SQL
C+ close c1
C/End-exec
/free
EndSr;
//---------------------------------------------------------------
// Build HTML line and write to browser
//---------------------------------------------------------------
BegSr SubrBuildLine;
Eval i += 1;
// Create link
link = ''
+ 'Map';
// Set table row color
If (SwapColor);
RowBgColor = BgColor1;
SwapColor = *OFF;
Else;
RowBgColor = BgColor2;
SwapColor = *ON;
EndIf;
Eval wrkline = ''
+ '| '
+ %char( i )
+ ' | '
+ ''
+ %trim( city )
+ ' | '
+ ''
+ %trim( state )
+ ' | '
+ ''
+ %trim( zipc )
+ ' | '
+ ''
+ %trim( link )
+ ' | '
+ '
'
;
CallP MakeHTML( %trim(WrkLine) + NewLine );
EndSr;
//---------------------------------------------------------------
// Stop Program
//---------------------------------------------------------------
BegSr StopPgm;
// Create HTML Message
If SndHTMLmsg = *On;
MakeHTML( 'Program stopped.....' +
NewLine );
EndIf;
*inLR = *ON;
Return;
EndSr;
//---------------------------------------------------------------
// Global error catcher
//---------------------------------------------------------------
BegSr *PSSR;
EndSr;
/end-free
//================================================================
// Function MakeHTML - Write string to StdOut
//================================================================
P MakeHTML b
D MakeHTML pi
D StringIn 2000 value
D Work s like(StringIn)
D StdOutLen s 9B 0
//----------------------------------------------------------------
// General API error routine
//----------------------------------------------------------------
DQUSEC DS
D qusbprv 1 4B 0 Inz( 16 ) Qus EC
D qusbavl 5 8B 0 Bytes Provided
D qusei 9 15 Bytes Available
D quserved 16 16 Exception Id
//----------------------------------------------------------------
// Calculate length of StdOut string
//----------------------------------------------------------------
/free
Work = %trim(StringIn);
Work = %trim(Work);
StdOutLen = %CheckR(' ':Work);
/end-free
//----------------------------------------------------------------
// Call QtmhWrStout API to write response HTML to StdOut
//----------------------------------------------------------------
C CallB(e) 'QtmhWrStout'
C Parm Work
C Parm StdOutLen
C Parm QUSEC
P MakeHTML e
//================================================================
// Function ReplaceIt - Replace something in a string
//================================================================
P ReplaceIt b export
D ReplaceIt pi 2000a
D Target 2000a const
D Source 2000a value
D StartPos 5i 0 const
D Length 5i 0 const
/free
Source = %replace( %trim(Target) :
Source :
StartPos :
Length );
Return Source;
/end-free
P ReplaceIt e
**CTDATA FormName
FORM_searchcity 01