Schreiben

Schreiben

IFS$WRITE (RPGLE)

X

*

*PSSR

BEGSR

IFS$WRITE

2

X

X

*

*ENTRY

PLIST

IFS$WRITE

8

X

*

IMAGEPARM

PLIST

IFS$WRITE

5

X

H

H

*COPYRIGHT JÜRGEN REULE 2010-2023

H

H

BNDDIR('QC2LE':'BAR$')

H

DATFMT(*ISO) TIMFMT(*ISO)

H

DFTACTGRP(*NO) ACTGRP('QILE')

H

COPYRIGHT('COPYRIGHT JÜRGEN REULE 2010-2023')

H

D

FILEPTR

S

*

D

FILELEN

S

10

I

0

D

PATHNAME

S

5000

A

VARYING

D

FILENAME

S

LIKE(PATHNAME)

D

FILENAMEX

S

5000

A

D

FILENAMEMIN

S

LIKE(FILENAME)

D

FILENAMEMINX

S

LIKE(FILENAMEX)

D

FILENAMEDLT

S

LIKE(FILENAME)

D

D

PATHNAMEDS

DS

INZ

D

PATHNAMEDS1

5000

A

INZ

D

1

A

INZ

D

FILENAMEDS

DS

INZ

D

FILENAMEDS1

5000

A

INZ

D

1

A

INZ

D

D

FD

S

10

I

0

INZ

D

RC

S

10

I

0

INZ

D

D

FORMAT

S

4

A

D

SUBMIT

S

1

A

D

D

CODEPAGE

C

CONST(819)

D

D

/COPY SOURCE,IFS$PROC

C

C

*

--------------------------------------

C

*

Datei löschen falls vorhanden

C

*

--------------------------------------

C

EVAL

FILENAMEDS = %TRIM(FILENAMEMIN)+NULL

C

EVAL

FD = UNLINK

(

%ADDR(FILENAMEDS))

C

C

*

--------------------------------------

C

*

Datei löschen falls vorhanden

C

*

--------------------------------------

C

EVAL

FILENAMEDS = %TRIM(FILENAMEDLT)+NULL

C

EVAL

FD = UNLINK

(

%ADDR(FILENAMEDS))

C

C

*

--------------------------------------

C

*

Pfad anlegen

C

*

--------------------------------------

C

EVAL

PATHNAMEDS = %TRIM(PATHNAME)+NULL

C

EVAL

RC = MKDIR

(

%ADDR(PATHNAMEDS):

C

OWNR+OWNW+OWNX+

C

GRPR +GRPX+

C

OTHR +OTHX)

C

*NULL

IFNE

FILEPTR

C

*

--------------------------------------

C

*

Datei anlegen und Daten sichern

C

*

--------------------------------------

C

EVAL

FILENAMEDS = %TRIM(FILENAME)+NULL

C

EVAL

FD = OPEN

(

%ADDR(FILENAMEDS):

C

OCODEPAGE+OTRUNC+

C

OCREATE +ORDWR:

C

OWNR+OWNW+OWNX+

C

GRPR +GRPX+

C

OTHR +OTHX:CODEPAGE)

C

FD

IFGE

*ZERO

C

EVAL

RC = WRITE

(

FD:FILEPTR:FILELEN)

C

EVAL

RC = CLOSE

(

FD)

C

ENDIF

C

ENDIF

C

*

--------------------------------------

C

*

Minibild erstellen

C

*

--------------------------------------

C

*BLANKS

IFNE

FILENAME

C

*BLANKS

ANDNE

FILENAMEMIN

C

MOVEL(P)

FILENAME

FILENAMEX

C

MOVEL(P)

FILENAMEMIN

FILENAMEMINX

C

CALL

'IMAGE'

IMAGEPARM

—

77

—

C

ENDIF

C

C

SETON

—

LR

—

C

C

*PSSR

BEGSR

C

ENDSR

'*CANCL'

C

C

*ENTRY

PLIST

C

PARM

FILEPTR

C

PARM

FILELEN

C

PARM

PATHNAME

C

PARM

FILENAME

C

PARM

FILENAMEMIN

C

PARM

FILENAMEDLT

C

PARM

FORMAT

C

X

*

*MAIN*

CALL

IFS$WRITE

X

C

IMAGEPARM

PLIST

C

PARM

FILENAMEX

C

PARM

FILENAMEMINX

C

PARM

FORMAT

C

PARM

'1'

SUBMIT

108 ms | Contact | Information | Aibo-Bar © 2005-2024