× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Hi

Code is attached below, the formatting seems to have gone a bit wonky sorry.


Thanks Neill


000001 S*NOTEXT Do Not Delete This Line
000010000000 H/TITLE EXT:Convert UniCode 2 937 Execute external functio
000020000000 H DATFMT(*YMD) DATEDIT(*YMD) DEBUG(*YES)
000030000000 H BNDDIR('QC2LE')
000040000000 H ACTGRP('QILE')
000050000000 H DFTACTGRP(*NO)
000060000000 Z* CRTBNDRPG
000070000000 Z* DFTACTGRP(*NO) BNDDIR(YBNDDIR) DBGVIEW(*SOURCE)
000080000000 Z* CVTOPT(*DATETIME) ACTGRP(*CALLER) OPTIMIZE(*BASIC)
000090000000 ?*
000100000000 W* Warning: This program does not set on the LR indicator
000110000000 ?*
000120000000 H* SYNOPSIS :
000130000000 H* Perform user function
000140000000 H* As defined by action diagram
000150000000 ?*
000160000000 H* Generated by AllFusion 2E release 8.1SP2 (1250)
000170000000 H* Function type : Execute external function
000180000000 H* Object type : *PGM
000190000000 ?*
000200000000 H* Company :????
000210000000 H* System : ?????
000220000000 H* User name : HARPNE
000230000000 H* Date : 26/02/09 Time : 14:52:32
000240000000 H* Copyright : ????
000250000000 ?*
000260000000
?*================================================================
000270000000 M* Maintenance :
000280000000
?*================================================================
000290000000 ?/EJECT
000300000000 ?* Data structures:
000310000000 D Pgmds ESDS Extname(Y2pgdspk)
000320000000 ?* Modified Program data structure
000330000000 D Jbdttm DS
000340000000 ?* Job date/time
000350000000 D Zzjdt 1 7 0
000360000000 D Zzjcc 1 1 0
000370000000 D Zzjyy 2 3 0
000380000000 D Zzjmm 4 5 0
000390000000 D Zzjdd 6 7 0
000400000000 D Zzjtm 8 13 0
000410000000 D Zzjhh 8 9 0
000420000000 D Zzjnn 10 11 0
000430000000 D Zzjss 12 13 0
000440000000 ?*
000450000000 ?* Declared stand-alone variables
000460000000 D P0rtn S 7
000470000000 D Wp0001 S 1
000480000000 D Wp0002 S 30
000490000000 D Wp0003 S 100
000500000000 D Wp0004 S 100
000510000000 D Wp0005 S 7
000520000000 D Wp0006 S 1
000530000000 D W0icl S 1
000540000000 D W0rtn S 7
000550000000 D W0rsl S 1
000560000000 D W0rsf S 1
000570000000 D W0rtw S 9 0
000580000000 D W0env S 3
000590000000 D Zztme S 6 0
000600000000 D Yile S 1
000610000000 D W0pmt S 1
000620000000 D TransHdl ds 52
000630000000 D Alpha 52A
000640000000 D siHandle 10i 0 Overlay(Alpha:*Next)
000650000000 D ToTrans DS
000660000000 D saToIBM 8A INZ('IBMCCSID')
000670000000 D saToCCSID 5A INZ('00950')
000680000000 D 19A
INZ(x'000000000000000000000000000000-
000690000000 D 00000000')
000700000000 D FromTrans DS
000710000000 D saFromIBM 8A INZ('IBMCCSID')
000720000000 D saFrCCSID 5A INZ('13488')
000730000000 D saConvAlt 3A INZ('000')
000740000000 D saSubstAlt 1A INZ('0')
000750000000 D saShift 1A INZ('0')
000760000000 D saInputLen 1A INZ('0')
000770000000 D saErrorOpt 1A INZ('0')
000780000000 D 12A
INZ(x'000000000000000000000000')
000790000000 D OpenTrans PR EXTPROC('iconv_open')

000800000000 D LIKE(TransHdl)
000810000000 D iaToTrans LIKE(ToTrans)
000820000000 D iaFromTrans LIKE(FromTrans)
000830000000 D Translate PR 10I 0 EXTPROC('iconv')
000840000000 D iaHandle LIKE(TransHdl) VALUE

000850000000 D iaInpBuff *
000860000000 D iiInpLen 10I 0
000870000000 D iaOutBuff *
000880000000 D iiOutLen 10I 0 CONST
000890000000 D retVal s 10i 0
000900000000 D InPointer S *
000910000000 D OutPointer S *
000920000000 D InSize S 10i 0
000930000000 D OutputSize S 10i 0
000940000000 D iConvClose PR 10I 0
EXTPROC('iconv_close')
000950000000 D iCHandle LIKE(TransHdl)
000960000000 ?/EJECT
000970000000 ?* Parameter declarations
000980000000 D P1parm DS
000990000000 ?* I : U:Function
001000000000 D P1dzsy 1 1
001010000000 D P2parm DS
001020000000 ?* B : U:Conversion Handle
001030000000 D P2dpna 1 30
001040000000 D P3parm DS
001050000000 ?* B : U:UNICODE from Alpha(100)
001060000000 D P3dmna 1 100
001070000000 D P4parm DS
001080000000 ?* B : U:Double Byte CCSID
001090000000 D P4dona 1 100
001100000000 D P5parm DS
001110000000 ?* O : U:Return Code
001120000000 D P5assv 1 7
001130000000 D P6parm DS
001140000000 ?* I : U:Closedown Program
001150000000 D P6hisv 1 1
001160000000 ?/EJECT
001170000000
?*****************************************************************
001180000000 ?* Entry parameters
001190000000 C *ENTRY Plist
001200000000 C Parm P0rtn
001210000000 C P1dzsy Parm Wp0001
U:Function
001220000000 C P2dpna Parm P2dpna Wp0002
U:Conversion Ha
001230000000 C P3dmna Parm P3dmna Wp0003
U:UNICODE from
001240000000 C P4dona Parm P4dona Wp0004
U:Double Byte C
001250000000 C P5assv Parm P5assv Wp0005
U:Return Code
001260000000 C P6hisv Parm Wp0006
U:Closedown Pro
001270000000
?*****************************************************************
001280000000 ?* Initialize
001290000000 C Exsr Zzinit
001300000000 ?*
001310000000 ?* EXT:Convert UniCode 2 937
001320000000 ?* Initialisation
001330000000 C Exsr Uasubr
Initialisation
001340000000 ?* Processing
001350000000 C Exsr Ubsubr
Processing
001360000000 ?* Closedown
001370000000 C Exsr Ucsubr
Closedown
001380000000
?*----------------------------------------------------------------
001390000000 ?* Exit program
001400000000 C Aaexit Tag
001410000000 C Eval P0rtn = ' '
001420000000 C Exsr Zyexpg
001430000000
?*================================================================
001440000000 ?/EJECT
001450000000 CSR Uasubr Begsr
001460000000
?*================================================================
001470000000 ?* Initialisation
001480000000
?*================================================================
001490000000 ?* Only if processing is required
001500000000 ?* CASE: PAR.U:Function is Process
001510000000 ?* USR:iconv_open - User Functions *
001520000000 W* Y2W0053 - One or more arguments defaulted to available
contexts
001530000000 ?* Field '(PAR) P2DPNA' defaulted for 'U:Conversion
Handle'.
001540000000 C If P1dzsy = 'P'
001550000000 * Header level H specs for function
001560000000 * D spec for entire function
001570000000 *
001580000000 *
001590000000 *
001600000000 *
001610000000 *
001620000000 *
001630000000 *
001640000000 /Free
001650000000 //If the supplied handle is blank then call iconv_open
to get the
001660000000 //required handle
001670000000 if P2DPNA = '';
001680000000 TransHdl = OpenTrans(ToTrans:FromTrans);
001690000000
001700000000 if siHandle < 0;
001710000000 siHandle = siHandle;
001720000000 Endif;
001730000000 P2DPNA = Alpha;
001740000000 Endif;
001750000000 /End-Free
001760000000 C End
*FI
001770000000
?*================================================================
001780000000 CSR Uaexit Endsr
001790000000 ?/EJECT
001800000000 CSR Ubsubr Begsr
001810000000
?*================================================================
001820000000 ?* Processing
001830000000
?*================================================================
001840000000 ?* If processing is required
001850000000 ?* CASE: PAR.U:Function is Process
001860000000 ?* USR:iconv - User Functions *
001870000000 C If P1dzsy = 'P'
001880000000 /Free
001890000000 //This is the conversion handle
001900000000 //It is defined in the iconv_open user source
001910000000 Alpha = P2DPNA;
001920000000
001930000000 //Set up pointers etc
001940000000
001950000000 InPointer = %Addr(P3DMNA);
001960000000 OutPointer = %Addr(P4DONA);
001970000000 InSize = %Size(P3DMNA);
001980000000 OutputSize = %Size(P4DONA);
001990000000
002000000000 retVal = translate(TransHdl:InPointer:InSize:
002010000000 OutPointer:OutputSize);
002020000000
002030000000 If retVal < 0;
002040000000 P5ASSV = 'FAIL';
002050000000 Else;
002060000000 P5ASSV = '';
002070000000 Endif;
002080000000 /End-Free
002090000000 C End
*FI
002100000000
?*================================================================
002110000000 CSR Ubexit Endsr
002120000000 ?/EJECT
002130000000 CSR Ucsubr Begsr
002140000000
?*================================================================
002150000000 ?* Closedown
002160000000
?*================================================================
002170000000 ?* Only is closedown is required
002180000000 ?* CASE: PAR.U:Closedown Program is Yes
002190000000 ?* USR:iconv_close - User Functions *
002200000000 W* Y2W0053 - One or more arguments defaulted to available
contexts
002210000000 ?* Field '(PAR) P2DPNA' defaulted for 'U:Conversion
Handle'.
002220000000 C If P6hisv = 'Y'
002230000000 *
002240000000 /Free
002250000000
002260000000 Alpha = P2DPNA;
002270000000
002280000000 iConvClose(TransHdl);
002290000000
002300000000 P2DPNA = '';
002310000000
002320000000 /End-Free
002330000000 ?* U:Set on LR - User Functions *
002340000000 C* Set on Last record indicator
002350000000 C MOVE '1' *INLR
002360000000 C End
*FI
002370000000
?*================================================================
002380000000 CSR Ucexit Endsr
002390000000 ?/EJECT
002400000000 CSR Zxexpg Begsr
002410000000
?*================================================================
002420000000 ?* Exit program: Normal
002430000000
?*================================================================
002440000000 C Exsr Zyexpg
002450000000
?*================================================================
002460000000 CSR Zxexit Endsr
002470000000 ?/EJECT
002480000000 CSR Zyexpg Begsr
002490000000
?*================================================================
002500000000 ?* Exit program: Direct
002510000000
?*================================================================
002520000000 ?* Copy any undisplayed messages back to caller
002530000000 C Call 'Y2CPMSC'
002540000000 C Parm Zzpgm
002550000000 C Parm 'Y' Yile
002560000000 ?*
002570000000 ?* Exit program
002580000000 C Return
002590000000 ?*
002600000000
?*================================================================
002610000000 CSR Zyexit Endsr
002620000000 ?/EJECT
002630000000 CSR Zzinit Begsr
002640000000
?*================================================================
002650000000 ?* Initialisation
002660000000
?*================================================================
002670000000 C If W0icl = ' '
002680000000 C Movel 'Y' W0icl
*Initial call
002690000000 C Else
002700000000 C Movel 'N' W0icl
002710000000 C End
002720000000 C Evalr P0rtn = ' '
002730000000 C Evalr W0rtn = ' '
002740000000 C Eval W0rsl = ' '
002750000000 C Eval W0rsf = ' '
002760000000 C Movel *ZEROS W0rtw
002770000000 C Movel '400' W0env
002780000000 ?* Initialise indicators for re-entry
002790000000 C Move '0' *IN
002800000000 ?* Retrieve job attributes
002810000000 C Call 'Y2RTJCR'
002820000000 C Parm Pgmds
002830000000 ?* Setup job date/time
002840000000 C Z-add Zzsd7 Zzjdt
002850000000 C Time Zzjtm
002860000000 ?* Update screen time
002870000000 C Time Zztme
002880000000 C Movel 'N' W0pmt
002890000000
?*================================================================
002900000000 CSR Zzexit Endsr

Neill Harper
From: midrange-l-bounces@xxxxxxxxxxxx
[mailto:midrange-l-bounces@xxxxxxxxxxxx] On Behalf Of Bruce Vining
Sent: 26 February 2009 23:47
To: Midrange Systems Technical Discussion
Subject: Re: Converting a unicode field to BIG5 code page 950

Can you post the relevant code (and sample data) that you are using? 
iconv() certainly supports 1200/13488 to 950 and is (most likely) what the
system will be using under the covers with any workaround you come up with. 
I would rather fix the problem in the calling code.

Bruce
Bruce Vining Services
507-206-4178

--- On Thu, 2/26/09, Neill Harper <neill.harper@xxxxxxxx> wrote:


From: Neill Harper <neill.harper@xxxxxxxx>
Subject: Converting a unicode field to BIG5 code page 950
To: "'Midrange Systems Technical Discussion'" <midrange-l@xxxxxxxxxxxx>
Date: Thursday, February 26, 2009, 3:16 PM


Hello



I have a field in a file that is Unicode CCSID (1200/13488) and I'd like to
convert its contents to code page 950.



When I use iconv, I get an error stating that a receiver is smaller than the
result of an operation.

Can anyone think of a quick way to do this without using iconv



Neill


As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.