; FILEFUNC
;
; Program for Proteus
;
; (C) 1998-2004 Simone Zanella Productions
;
; Functions used to verify and split file names (DOS, Windows™, Unix™).


FUNCTION ChkPathFileWindows(pathname)

  ; Return 0 if and only if pathname is not a valid filename under Windows™.
  ; Pathnames including ".." are not allowed.

  ; Relative path?
  IF STRSTR(pathname, "..")
    RETURN 0
  FI
  ntok = NUMTOKEN(pathname, "\\")
  ; Path is empty, or ends in ':' or '\'  - not valid
  IF OR(EQ(ntok, 0), IN(RIGHT(pathname, 1), ":\\"))
    RETURN 0
  FI
  FOR x = 1 TO ntok
    s = TOKEN(pathname, x, "\\")
    IF EQ(x, 1)
      ; The first token can have the format 'A:',
      ; where A is a drive letter
      IF AND(EQ(STRLEN(s), 2), \
             STREQ(RIGHT(s, 1), ":"))
        IF NOT(REXMATCH(s, "[A-Za-z]:"))
          RETURN 0
        FI
      ELSE
        ; Verify a standard file name
        IF NOT(ChkNameWindows(s))
          RETURN 0
        FI
      FI
    ELSE
      IF NOT(ChkNameWindows(s))
        RETURN 0
      FI
    FI
  NEXT
  ; Windows™ file names must have length <= 255 characters
RETURN LE(STRLEN(pathname), 255)


FUNCTION ChkNameWindows(filename)

  ; Return 0 if and only if filename is not a valid file name under Windows™

  len = STRLEN(filename)
  FOR x = 1 TO len
    car = UPPER(SUBSTR(filename, x, 1))
    ; Verify that the character is allowed
    IF NOT(IN(car, \
           "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_^$~!#%&+,;=[] -{}()@'`."))
      RETURN 0
    FI
  NEXT
  ; Windows™ file names must have length <= 255 characters
RETURN AND(LE(len, 255), NEQ(len, 0))


FUNCTION ChkPathFileDos(pathname)

  ; Return 0 if and only if pathname is not a valid file name under Ms-Dos™.
  ; Only absolute paths are allowed.

  ; Relative path?
  IF STRSTR(pathname, "..")
    RETURN 0
  FI
  ntok = NUMTOKEN(pathname, "\\")
  ; Path is empty, or ends in ':' or '\'  - not valid
  IF OR(EQ(ntok, 0), IN(RIGHT(pathname, 1), ":\\"))
    RETURN 0
  FI
  FOR x = 1 TO ntok
    s = TOKEN(pathname, x, "\\")
    IF EQ(x, 1)
      ; The first token can have the format 'A:',
      ; where A is a drive letter
      IF AND(EQ(STRLEN(s), 2), \
             STREQ(RIGHT(s, 1), ":"))
        IF NOT(REXMATCH(s, "[A-Za-z]:"))
          RETURN 0
        FI
      ELSE
        ; Verify standard file name
        IF NOT(ChkNameDos(s))
          RETURN 0
        FI
      FI
    ELSE
      IF NOT(ChkNameDos(s))
        RETURN 0
      FI
    FI
  NEXT
  ; DOS file names must have length <= 67 characters
RETURN LE(STRLEN(pathname), 67)


FUNCTION ChkNameDos(filename)

  ; Return 0 if and only if filename is not a valid file name under Ms-Dos™.

  len = STRLEN(filename)
  ext = 0
  nlen = 0
  elen = 0
  FOR x = 1 TO len
    car = UPPER(SUBSTR(filename, x, 1))
    IF STREQ(car, ".")
      IF ext
        RETURN 0
      ELSE
        ext = 1
      FI
    ELSE
      ; Verify that the character is allowed
      IF NOT(IN(car, \
             "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_^$~!#%&-{}()@'`"))
        RETURN 0
      FI
      IF ext
        INC(@elen)
      ELSE
        INC(@nlen)
      FI
    FI
  NEXT
  IF OR(EQ(nlen, 0), GT(nlen, 8))
    RETURN 0
  FI
RETURN IIF(GT(elen, 3), 0, 1)


FUNCTION ChkPathFileUnx(pathname)

  ; Return 0 if and only if pathname is not a valid file name under Unix™.
  ; Absolute paths are not allowed.

  ; Relative path?
  IF STRSTR(pathname, "..")
    RETURN 0
  FI
  ntok = NUMTOKEN(pathname, "/")
  ; Path is empty, or ends in '/'  - not valid
  IF OR(EQ(ntok, 0), IN(RIGHT(pathname, 1), "/"))
    RETURN 0
  FI
  FOR x = 1 TO ntok
    s = TOKEN(pathname, x, "/")
    IF EQ(x, 1)
      ; First token cannot be empty
      IF ISNOTEMPTY(s)
        ; Check standard file name
        IF NOT(ChkNameUnx(s))
          RETURN 0
        FI
      FI
    ELSE
      IF NOT(ChkNameUnx(s))
        RETURN 0
      FI
    FI
  NEXT
  ; Unix™ file names must have length <= 255 characters
RETURN LE(STRLEN(pathname), 255)


FUNCTION ChkNameUnx(filename)

  ; Return 0 if and only if filename is not a valid file name under Unix™.

  len = STRLEN(filename)
  FOR x = 1 TO len
    car = UPPER(SUBSTR(filename, x, 1))
    ; Controlla se il carattere è ammesso
    IF NOT(IN(car, \
           "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_^$~!#%&+,;=[] -{}()@'`."))
      RETURN 0
    FI
  NEXT
  ; Unix™ file names must have length <= 255 characters
RETURN AND(LE(len, 255), NEQ(len, 0))


FUNCTION DosSplit(pathname, vh)

  ; Store in the array vh (previously allocated, of size at least 4)
  ; the components of pathname:
  ; 1  drive
  ; 2  path
  ; 3  name
  ; 4  extension

  s = LEFT(pathname, 2)
  ; Isolate drive
  IF REXMATCH(s, "[A-Za-z]:")
    VECSET(vh, 1, s)
    pathname = RESTFROM(pathname, 3)
  ELSE
    VECSET(vh, 1, "")
  FI
  ; Isolate directory
  p = STRRSTR(pathname, "\\")
  IF p
    VECSET(vh, 2, LEFT(pathname, p))
    pathname = RESTFROM(pathname, INC(p))
  ELSE
    VECSET(vh, 2, "")
  FI
  IF ISNOTEMPTY(pathname)
    ; Isolate extension
    p = STRRSTR(pathname, ".")
    IF p
      VECSET(vh, 4, RESTFROM(pathname, p))
      pathname = LEFT(pathname, DEC(p))
    ELSE
      VECSET(vh, 4, "")
    FI
    ; Isolate file name
    VECSET(vh, 3, pathname)
  ELSE
    VECSET(vh, 3, "")
    VECSET(vh, 4, "")
  FI
RETURN


FUNCTION UnxSplit(pathname, vh)

  ; Store in the array vh (previously allocated, of size at least 4)
  ; the components of pathname:
  ; 1  path
  ; 2  name
  ; 3  extension

  ; Isolate directory
  p = STRRSTR(pathname, "/")
  IF p
    VECSET(vh, 1, LEFT(pathname, p))
    pathname = RESTFROM(pathname, INC(p))
  ELSE
    VECSET(vh, 1, "")
  FI
  IF ISNOTEMPTY(pathname)
    ; Isolate extension
    p = STRRSTR(pathname, ".")
    IF p
      VECSET(vh, 3, RESTFROM(pathname, p))
      pathname = LEFT(pathname, DEC(p))
    ELSE
      VECSET(vh, 3, "")
    FI
    ; Isolate file name
    VECSET(vh, 2, pathname)
  ELSE
    VECSET(vh, 2, "")
    VECSET(vh, 3, "")
  FI
RETURN