; ARC
;
; Program for Proteus
;
; (C) 1998-2004 Simone Zanella Productions
;
; This program creates an archive file including all files specified, which
; can be later extracted by using DEARC.

#!proteus -z

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

VH = VECNEW(4)
HDest = FOPEN(ARGV(5), 26)
IF EQ(HDest, -1)
  CONSOLELN "Error: could not create/write to " 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 "Error: no file found matching " ARGV(X)
    INC(@ErrorNum)
  FI
  WHILE GT(F, 0)
    ; File found
    Name = DIRLAST(H, 1)
    Size = DIRLAST(H, 2)
    ; Open for reading
    CONSOLELN "Adding 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)
      ; File opened - copy until the end of file
      WHILE NOT(FEOF(FH))
        L = FREAD(FH, 8192)
        FWRITE(HDest, L)
      LOOP
      FCLOSE(FH)
    ELSE
      CONSOLELN "Error: could not open " Name
      INC(@ErrorNum)
    FI
    F = DIRNEXT(H)
  LOOP
  DIRCLOSE(H)
NEXT
IF GT(ErrorNum, 0)
  CONSOLELN "Warning: a few files could not be copied."
  ABORT 2
ELSE
  CONSOLELN "Archive " ARGV(5) " succesfully created."
FI
ABORT 0


FUNCTION QualifyPath(path, name)

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


FUNCTION DosSplit(pathname, vh)

  ; Store into the array vh (pre-allocated, size at least 4)
  ; the various parts 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 filename
    VECSET(vh, 3, pathname)
  ELSE
    VECSET(vh, 3, "")
    VECSET(vh, 4, "")
  FI
RETURN