; ARC
;
; Programma per Proteus
;
; (C) 1998-2003 Simone Zanella Productions
;
; Questo programma crea un archivio contenente tutti i file specificati,
; estraibile mediante DEARC.

#!proteus -z

IF LT(ARGC, 6)
  CONSOLELN "Sintassi: " ARGV(1) " " ARGV(2) " <dest> <filespec> [<filespec> ..]"
  ABORT 0
FI

VH = VECNEW(4)
HDest = FOPEN(ARGV(5), 26)
IF EQ(HDest, -1)
  CONSOLELN "Errore: impossibile creare/scrivere " ARGV(5)
  ABORT 1
FI

ErrorNum = 0
FOR X = 6 TO ARGC
  H = DIROPEN(ARGV(X), 1)
  DosSplit(ARGV(X), VH)
  BasePath = VECGET(VH, 1) VECGET(VH, 2)
  F = IIF(NEQ(H, -1), 1, 0)
  IF NOT(F)
    CONSOLELN "Errore: nessun file trovato corrispondente a " ARGV(X)
    INC(@ErrorNum)
  FI
  WHILE GT(F, 0)
    ; File trovato
    Name = DIRLAST(H, 1)
    Size = DIRLAST(H, 2)
    ; Apro per lettura
    CONSOLELN "Aggiungo file: " QualifyPath(BasePath, Name)
    FH = FOPEN(QualifyPath(BasePath, Name), 1)
    IF NEQ(FH, -1)
      FWRITE(HDest, CHR(STRLEN(Name)))
      FWRITE(HDest, Name)
      FWRITE(HDest, CHR(STRLEN(Size)))
      FWRITE(HDest, Size)
      ; Apertura ok - trascrivo fino a fine file
      WHILE NOT(FEOF(FH))
        L = FREAD(FH, 8192)
        FWRITE(HDest, L)
      LOOP
      FCLOSE(FH)
    ELSE
      CONSOLELN "Errore: impossibile aprire " Name
      INC(@ErrorNum)
    FI
    F = DIRNEXT(H)
  LOOP
  DIRCLOSE(H)
NEXT
IF GT(ErrorNum, 0)
  CONSOLELN "Attenzione: alcuni file non sono stati copiati."
  ABORT 2
ELSE
  CONSOLELN "Archivio " ARGV(5) " creato correttamente."
FI
ABORT 0


FUNCTION QualifyPath(path, name)

IF ISNOTEMPTY(path)
  RETURN STRTRAN(path "\\" name, "\\\\", "\\")
FI
RETURN name


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