| 
*===================================================================== * File Procedures * * Copyright (C) Julian Monypenny 1997 *===================================================================== H NoMain *--------------------------------------------------------------------- * Global definitions *--------------------------------------------------------------------- /Copy ToolkitCpy,ApiErrH /Copy ToolkitCpy,CmdH /Copy ToolkitCpy,FilH /Copy ToolkitCpy,MbrH /Copy ToolkitCpy,ObjH /Copy ToolkitCpy,StdTypH *===================================================================== P CreateFil B Export *===================================================================== D Pi Like( LglTyp ) D FilNam Like( NamTyp ) Value D FilLib Like( NamTyp ) Value * Name, *CURLIB, or *LIBL D MbrNam Like( NamTyp ) Value D RcdLen_O Like( IntTyp ) Value D Options( *NoPass ) D FilTxt_O Like( TxtTyp ) Value D Options( *NoPass ) D RcdLen S Like( IntTyp ) D FilTxt S Like( TxtTyp ) C If %Parms > 3 C Eval RcdLen = RcdLen_O C EndIf C If %Parms > 4 C Eval FilTxt = FilTxt_O C EndIf C If FilExists( FilNam: FilLib: MbrNam ) C = *On And C ExecCmd( 'ClrPfm ' + %Trim( FilLib ) + |
|
C '/' + %Trim( FilNam ) +
C ' ' + %Trim( MbrNam ) )
C = *On
C Return *On
C EndIf
C If FilExists( FilNam: FilLib )
C = *On And
C ExecCmd( 'AddPfm ' + %Trim( FilLib ) +
C '/' + %Trim( FilNam ) +
C ' ' + %Trim( MbrNam ) )
C = *On
C Return *On
C EndIf
C If FilLib = '*LIBL'
C Eval FilLib = '*CURLIB'
C EndIf
C If ExecCmd( 'CrtPf ' + %Trim( FilLib ) +
C '/' + %Trim( FilNam ) +
C ' ' +
C 'Mbr(' + %Trim( MbrNam ) +
C ') ' +
C 'Text(''' + %Trim( FilTxt ) +
C ''') ' +
C 'RcdLen(' +
C %EditC( RcdLen: '4' ) +
C ') ' +
C 'MaxMbrs( *NoMax ) ' +
C 'ReuseDlt( *Yes ) ' +
C 'Size( *NoMax )' )
C = *On
C Return *On
C EndIf
C Return *Off
P E
*=====================================================================
P DeleteFil B Export
*=====================================================================
D Pi Like( LglTyp )
|
|
D FilNam Like( NamTyp ) Value D FilLib Like( NamTyp ) Value * Name, *CURLIB, or *LIBL D MbrNam Like( NamTyp ) Value D Options( *NoPass ) C If %Parms = 2 And C FilExists( FilNam: FilLib ) C = *On And C ExecCmd( 'DltF ' + %Trim( FilLib ) + C '/' + %Trim( FilNam ) ) C = *On C Return *On C EndIf C If %Parms = 3 And C FilExists( FilNam: FilLib: MbrNam ) C = *On And C ExecCmd( 'RmvM ' + %Trim( FilLib ) + C '/' + %Trim( FilNam ) + C ' ' + %Trim( MbrNam ) ) C = *On C Return *On C EndIf C Return *Off P E *===================================================================== P CopyFil B Export *===================================================================== D Pi Like( LglTyp ) D FilNam Like( NamTyp ) Value D FilLib Like( NamTyp ) Value * Name, *CURLIB, or *LIBL D NewFil Like( NamTyp ) Value D NewLib Like( NamTyp ) Value D NewTxt_O Like( TxtTyp ) Value D Options( *NoPass ) D NewTxt S Like( TxtTyp ) C If %Parms > 4 |
|
C Eval NewTxt = NewTxt_O
C EndIf
C If GetObjDsc( FilNam: FilLib:
C '*FILE': BrfObjDscFmt:
C ObjDscDs ) = *On
C Eval FilLib = ObjRtnLib
C Else
C Return *Off
C EndIf
C If NewLib = '*LIBL'
C Eval NewLib = '*CURLIB'
C EndIf
C If ExecCmd( 'CrtDupObj ' + FilNam +
C ' ' + FilLib +
C ' *File ' +
C 'ToLib(' + NewLib +
C ') ' +
C 'NewObj(' + NewFil +
C ') ' ) = *Off
C Return *Off
C EndIf
C If %Parms > 4 And
C ExecCmd( 'ChgPf ' + %Trim( NewLib ) +
C '/' + %Trim( NewFil ) +
C ' ' +
C 'Text(''' + %Trim( NewTxt ) +
C ''') ' ) = *Off
C Return *Off
C EndIf
C Return *On
P E
*=====================================================================
P FilExists B Export
*=====================================================================
D Pi Like( LglTyp )
D FilNam Like( NamTyp ) Value
D FilLib Like( NamTyp ) Value
|
|
* Name, *CURLIB, or *LIBL D MbrNam Like( NamTyp ) Value D Options( *NoPass ) C If %Parms = 3 C Return MbrExists( FilNam: FilLib: MbrNam ) C Else C Return ObjExists( FilNam: FilLib: '*FILE' ) C EndIf P E *===================================================================== P GetFilRcdLen B Export *===================================================================== D Pi Like( LglTyp ) D FilNam Like( NamTyp ) Value D FilLib Like( NamTyp ) Value * Name, *CURLIB, or *LIBL D RcdLen Like( IntTyp ) D QFilNam S Like( QNamTyp ) D DscFmt S Like( ApiFmtTyp ) D Inz( 'FILD0100' ) D FilOvr S Like( ChrTyp ) Inz( *Off ) D FilRcd S Like( NamTyp ) D FilSys S Like( NamTyp ) Inz( '*LCL' ) D FmtTyp S Like( NamTyp ) Inz( '*EXT' ) * API fails if FilDscDs is less than 704 bytes D FilDscDs Ds 704 Inz D FilDscLen Like( IntTyp ) D FilDscSiz Like( IntTyp ) D 296 D FilRcdLen Like( SmlIntTyp ) C Reset FilDscDs C Eval QFilNam = FilNam + FilLib C Eval FilDscSiz = %Size( FilDscDs ) C Call 'QDBRTVFD' C Parm FilDscDs C Parm FilDscSiz |
|
C Parm QFilNam
C Parm DscFmt
C Parm QFilNam
C Parm FilRcd
C Parm FilOvr
C Parm FilSys
C Parm FmtTyp
C Parm ApiErrDs
C Eval RcdLen = FilRcdLen
C Return ( ApiErrLen = 0 )
P E
*=====================================================================
P LinkFil B Export
*=====================================================================
D Pi Like( LglTyp )
D FilNam Like( NamTyp ) Value
D ToFil Like( NamTyp ) Value
D ToLib Like( NamTyp ) Value
* Name, *CURLIB, or *LIBL
D ToMbr Like( NamTyp ) Value
D FilOpts_O Like( StrTyp ) Value
D Options( *NoPass )
D FilOpts S Like( StrTyp )
C If %Parms > 4
C Eval FilOpts = FilOpts_O
C EndIf
C If FilExists( ToFil: ToLib: ToMbr ) = *Off
C Return *Off
C EndIf
C Return ExecCmd( 'OvrDbf ' + FilNam + ' ' +
C 'ToFile(' + %Trim( ToLib ) +
C '/' + %Trim( ToFil ) +
C ') ' +
C 'Mbr(' + %Trim( ToMbr ) +
C ') ' +
C 'SeqOnly( *Yes 10 ) ' +
|
|
C 'OvrScope( *Job ) ' + C FilOpts ) P E *===================================================================== P UnlinkFil B Export *===================================================================== D Pi Like( LglTyp ) D FilNam Like( NamTyp ) Value C Return ExecCmd( 'DltOvr ' + FilNam + ' ' + C 'Lvl( *Job )' ) P E |
