forum.clarionlife.net

Код: Выделить всё

CreateZIPFile    PROCEDURE
nam1             CSTRING(40),STATIC   
nam2             CSTRING(40) 
Loc:STR          STRING(22) 
Loc:Object       CSTRING(65) 

arx1 FILE,DRIVER('DOS'),PRE(ar1),NAME(nam1),create 
Rec    RECORD             
Name    STRING(22)                 
      END
    END                               

  CODE
   nam1 = 'e:\test_zip1\archiv.zip'
   nam2 = 'e:\test_zip1\Language.doc'
    IF EXISTS(nam1)
        OPEN(arx1 )
       EMPTY(arx1)
    ELSE     
       CREATE(arx1)
        OPEN(arx1)
    .
  ! --- Сформировать пустой ZIP файл ---
  Loc:STR = '<80><75><5><6>' & All(Chr(0),18)  ! Бинарное содержание пустого ZIP файла
     arx1.Rec.Name = Loc:STR
    ADD(arx1)
    IF ERROR()
        MESSAGE(ERROR())
    .    
    CLOSE(arx1)
  !------------------------

   Loc:Object                                   = Create(0,Create:Ole)
   Loc:Object{Prop:Create}               = 'Shell.Application'
   Loc:Object{Prop:ReportException} = True   ! Выдавать сообщения об ошибках - можно убрать

   ! Записать файл shet.doc в архив archiv.zip
   Loc:Object{'NameSpace(nam1).CopyHere(nam2,20)'}
   ! Дождаться завершения архивации, иначе получим GPF
   Loop until Loc:Object{'NameSpac(nam1).Items().Count'} = 1
       Yield
    end

    ! Удалить используемый объект и освободить память
    Loc:Object{Prop:Deactivate}
    

Код: Выделить всё

AllFiles  QUEUE,PRE(FIL)
name        STRING(FILE:MAXFILENAME) 
shortname   STRING(13)
Date        LONG       !дата
Time        LONG       !время
Size        LONG       !размер
Attrib      BYTE       !
          END

LOC:BackupName   CSTRING(255),STATIC !полное имя ZIP-файла (с путем)
LOC:FilePath     CSTRING(255)
Loc:Object       CSTRING(255)

DosFile FILE,DRIVER('DOS'),PRE(DF),NAME(LOC:BackupName),create
Rec    RECORD             
Name    STRING(22)
      END
    END

 if not exists(LOC:BackupName) !если нет архива за прошлый месяц, то создаем его

    Create(DosFile); Open(DosFile)
    DosFile.Rec.Name='<80><75><5><6>'& All(Chr(0),18); Add(DosFile) !формируем пустой ZIP-файл
    if ERROR() then Message(ERROR()); end
    Close(DosFile)

    DIRECTORY(AllFiles,clip(LOC:FilePath) &'*.mdb',ff_:NORMAL) !Получить список файлов в каталоге
    Recs# = RECORDS(AllFiles); !определяем количество файлов в очереди
    LOOP i# = 1 TO Recs# !цикл по всем элементам очереди
         GET(AllFiles,i#); !message(FIL:Name)
         Loc:Object = Create(0,Create:Ole)
         Loc:Object{Prop:Create} = 'Shell.Application'
         Loc:Object{Prop:ReportException} = True !выдаем сообщение о ошибке
         !добавляем файл в архив
         Loc:Object{'NameSpace("' & LOC:BackupName & '").CopyHere("' & Clip(clip(LOC:FilePath) & clip(FIL:Name)) &'",20)'}
         Loop until Loc:Object{'NameSpace("'& LOC:BackupName &'").Items().Count'} = i# !ждем окончания архивации i# файла
             Yield !передаем управление другим WINDOWS-программам
         end
         Loc:Object{Prop:Deactivate} !удаляем используемый объект и освобождаем память
    end
    free(AllFiles) !освобождаем очередь
 end