putf.src

来自「没有说明」· SRC 代码 · 共 115 行

/*
** putf.src - Write string to disk
** (C) Copyright 1990-1998 by Aptech Systems, Inc.
** All Rights Reserved.
**
** This Software Product is PROPRIETARY SOURCE CODE OF APTECH
** SYSTEMS, INC.    This File Header must accompany all files using
** any portion, in whole or in part, of this Source Code.   In
** addition, the right to create such files is strictly limited by
** Section 2.A. of the GAUSS Applications License Agreement
** accompanying this Software Product.
**
** If you wish to distribute any portion of the proprietary Source
** Code, in whole or in part, you must first obtain written
** permission from Aptech Systems.
**
**> putf
**
**  Purpose:   Writes string to disk.
**
**  Format:    retcode = putf(fname,str,start,len,mode,append);
**
**  Input:   fname      string, name to be given file on disk.
**
**           str        string to be written to disk.
**
**           start      where in str string to be written starts.
**
**           len        length of string to be written.
**
**           mode       0 - ASCII, 1 - binary.  If binary a string of
**                      length len will be written.  If ASCII a string
**                      of length len or a string up to but not including
**                      ^Z (ASCII \026) will be written, whichever is
**                      shorter.
**
**           append     0 - write file (if file exists it will be written
**                      over), 1 - append file (if file doesn't exist
**                      file will be written anyway).
**
**  Output:  retcode    scalar, return code.
**                      0 - normal return
**                      1 - null file name
**                      2 - file open error
**                      3 - file write error
**                      4 - string too long
**                      5 - null string or illegal mode value
**                      6 - invalid append value
**
*/


proc putf(fname,str,start,len,mode,append);
    local buf,errcode,error5,flag;

    fname = "" $+ fname;
    if fname $== ""; goto errout(1); endif;

    if append[1,1] /= 0 and append[1,1] /= 1; goto errout(6); endif;

    error5 = 1;
    if mode[1,1] /= 0 and mode[1,1] /= 1; goto errout(5); endif;

    error5 = 2;
    str = strsect("" $+ str,start,len);
    if str $== ""; goto errout(5); endif;
    if mode[1,1] == 0;
        if strsect(str,1,1) $== chrs(26); goto errout(5); endif;
    endif;
    len = strlen(str);

    clear errcode;

#ifDLLCALL
#else

    buf = zeros(2583,1);
    loadexe buf = putf.rex;
    callexe buf(fname,str,len,mode,append,errcode);

#endif

#ifDLLCALL

    dllcall putf(fname,str,len,mode,append,errcode);

#endif

    goto errout(errcode);

errout:
    pop errcode;

    if errcode==0 or trapchk(4);
        retp(errcode);
    elseif errcode==1;
        errorlog "ERROR: null file name";
    elseif errcode==2;
        errorlog "ERROR: file open error";
    elseif errcode==3;
        errorlog "ERROR: file write error";
    elseif errcode==4;
        errorlog "ERROR: string too long";
    elseif errcode==5;
        if error5==1;
            errorlog "ERROR: invalid mode value";
        else;
            errorlog "ERROR: null string";
        endif;
    elseif errcode==6;
        errorlog "ERROR: invalid append value";
    endif;
    end;
endp;