; FILEFUNC
;
; Programma per Proteus
;
; (C) 1998-2003 Simone Zanella Productions
;
; Funzioni per verificare e suddividere nomi di file (DOS, Windows™, Unix™).


FUNCTION ChkPathFileWindows(pathname)

  ; Ritorna 0 se e solo se pathname non è un nome di file valido
  ; sotto Windows™.
  ; I percorsi che contengono ".." non sono ammessi.

  ; Path relativo?
  IF STRSTR(pathname, "..")
    RETURN 0
  FI
  ntok = NUMTOKEN(pathname, "\\")
  ; Percorso vuoto, o termina in ':' o '\'  - non valido
  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)
      ; Il primo token può essere del tipo 'A:',
      ; dove A è una lettera di drive
      IF AND(EQ(STRLEN(s), 2), \
             STREQ(RIGHT(s, 1), ":"))
        IF NOT(REXMATCH(s, "[A-Za-z]:"))
          RETURN 0
        FI
      ELSE
        ; Verifica un nome di file standard
        IF NOT(ChkNameWindows(s))
          RETURN 0
        FI
      FI
    ELSE
      IF NOT(ChkNameWindows(s))
        RETURN 0
      FI
    FI
  NEXT
  ; I nomi di file Windows™ devono avere lunghezza <= 255 caratteri
RETURN LE(STRLEN(pathname), 255)


FUNCTION ChkNameWindows(filename)

  ; Ritorna 0 se e solo se filename non è un nome di file valido
  ; sotto Windows™

  len = STRLEN(filename)
  FOR x = 1 TO len
    car = UPPER(SUBSTR(filename, x, 1))
    ; Verifica che il carattere sia ammesso
    IF NOT(IN(car, \
           "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_^$~!#%&+,;=[] -{}()@'`."))
      RETURN 0
    FI
  NEXT
  ; I nomi di file Windows™ devono avere lunghezza <= 255 caratteri
RETURN AND(LE(len, 255), NEQ(len, 0))


FUNCTION ChkPathFileDos(pathname)

  ; Ritorna 0 se e solo se pathname non è un nome di file valido
  ; sotto Ms-Dos™.
  ; Sono ammessi solo percorsi assoluti.

  ; Percorso relativo?
  IF STRSTR(pathname, "..")
    RETURN 0
  FI
  ntok = NUMTOKEN(pathname, "\\")
  ; Percorso vuoto, o termina in ':' o '\'  - non valido
  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)
      ; Il primo token può essere di tipo 'A:',
      ; dove A è una lettera di drive
      IF AND(EQ(STRLEN(s), 2), \
             STREQ(RIGHT(s, 1), ":"))
        IF NOT(REXMATCH(s, "[A-Za-z]:"))
          RETURN 0
        FI
      ELSE
        ; Controlla il nome di file standard
        IF NOT(ChkNameDos(s))
          RETURN 0
        FI
      FI
    ELSE
      IF NOT(ChkNameDos(s))
        RETURN 0
      FI
    FI
  NEXT
  ; I nomi di file DOS devono avere lunghezza <= 67 caratteri
RETURN LE(STRLEN(pathname), 67)


FUNCTION ChkNameDos(filename)

  ; Ritorna 0 se e solo se filename non è un nome di file valido
  ; sotto 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
      ; Controlla se il carattere è ammesso
      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)

  ; Ritorna 0 se e solo se pathname non è un nome di file valido
  ; sotto Unix™
  ; Sono ammessi solo percorsi assoluti.

  ; Percorso relativo?
  IF STRSTR(pathname, "..")
    RETURN 0
  FI
  ntok = NUMTOKEN(pathname, "/")
  ; Percorso vuoto, o termina in '/'  - non valido
  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)
      ; Il primo token può essere vuoto
      IF ISNOTEMPTY(s)
        ; Controlla il nome di file standard
        IF NOT(ChkNameUnx(s))
          RETURN 0
        FI
      FI
    ELSE
      IF NOT(ChkNameUnx(s))
        RETURN 0
      FI
    FI
  NEXT
  ; I nomi di file Unix™ devono avere lunghezza <= 255 caratteri?
RETURN LE(STRLEN(pathname), 255)


FUNCTION ChkNameUnx(filename)

  ; Ritorna 0 se e solo se filename non è un nome di file valido
  ; sotto 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
  ; I nomi di file Unix™ devono avere lunghezza <= 255 caratteri?
RETURN AND(LE(len, 255), NEQ(len, 0))


FUNCTION DosSplit(pathname, vh)

  ; Memorizza nel vettore (pre-allocato, di dimensione almeno 4)
  ; corrispondente a vh le componenti di pathname:
  ; 1  drive
  ; 2  percorso
  ; 3  nome
  ; 4  estensione

  s = LEFT(pathname, 2)
  ; Isola il drive
  IF REXMATCH(s, "[A-Za-z]:")
    VECSET(vh, 1, s)
    pathname = RESTFROM(pathname, 3)
  ELSE
    VECSET(vh, 1, "")
  FI
  ; Isola la 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)
    ; Isola l'estensione
    p = STRRSTR(pathname, ".")
    IF p
      VECSET(vh, 4, RESTFROM(pathname, p))
      pathname = LEFT(pathname, DEC(p))
    ELSE
      VECSET(vh, 4, "")
    FI
    ; Isola il nome di file
    VECSET(vh, 3, pathname)
  ELSE
    VECSET(vh, 3, "")
    VECSET(vh, 4, "")
  FI
RETURN


FUNCTION UnxSplit(pathname, vh)

  ; Memorizza nel vettore (pre-allocato, di dimensione almeno 3)
  ; corrispondente a vh le componenti di pathname:
  ; 1  percorso
  ; 2  nome
  ; 3  estensione

  ; Isola la 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)
    ; Isola l'estensione
    p = STRRSTR(pathname, ".")
    IF p
      VECSET(vh, 3, RESTFROM(pathname, p))
      pathname = LEFT(pathname, DEC(p))
    ELSE
      VECSET(vh, 3, "")
    FI
    ; Isola il nome di file
    VECSET(vh, 2, pathname)
  ELSE
    VECSET(vh, 2, "")
    VECSET(vh, 3, "")
  FI
RETURN