Архивация ZIP без ... ZIP

[nik190994]

Не могу повторить...
Не отрабатывает строка
Loc:Object{'NameSpace("e:\test_zip1\archiv.zip").CopyHere("e:\test_zip1\Language.doc",20)'}

Сам файл создается но в него ничего не копируется... В чем может быть дело?

[Shur]

Весь код, пожалуйста. Предположительно где-то напутал с созданием пустого прото-zip-файла.

[nik190994]

Вот...

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

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}
    

Как учили...

[Игорь Столяров]

Loc:Object{'NameSpace(nam1).CopyHere(nam2,20)'}

Конечно неправильно ... Нужно имена файлов брать в двойные ковычки.

Loc:Object{'NameSpace("' & Clip(Left(nam1)) & '").CopyHere("' & Clip(Left(nam2)) &'",20)'}

и так далее по тексту.

[nik190994]

Опять не получилось...
Что то у меня не так...
Эта схема работает у многих... Видел варианты в сети на С и VB...

[Yufil]

Попробуй так
Bind('nam1',nam1)
Bind('nam2',nam2)
Loc:Object{'NameSpace(&nam1).CopyHere(&nam2,20)'}

[Игорь Столяров]

Опять не получилось...

Ну вот код скопированный из рабочей программы, работает на десятках разных компьютеров:

Loc:Object{'NameSpace("' & Clip(Left(ZipFile_)) & '").CopyHere("' & Clip(Left(Source_)) & '",20)'}

Может быть это проблема с русскими именами файлов, о которой написали ниже ?
Тогда попробуй вставить перед этим кодом, перекодировку в OEM: CONVERTANSITOOEM(Source_) ....

Также может быть косяк с созданием пустого ZIP файла. Попробуй отключить свой код и добавить
файл в пустой ZIP архив, который создан средствами обычного архиватора (я DOS драйвер вообще не люблю ...)

[soft42]

Добрый день.
Тоже решил избавиться от библиотеки ZLIB, паковать средствами Windows. Воспользовался примером Игоря Столярова, за что ему огромное спасибо Упаковка одного файла идет замечательно. Но мне надо архивировать несколько файлов в один архив. Под это дело незначительно изменил код. Но время от времени получаю ошибку:
"OLE Error: Get Named Property Failed (080020003H). Член группы не найден. "NameSpace("2012-09.ZIP").Items().Count"
Подозреваю, все дело в этом NameSpace().Items . Вот кусок кода:

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

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

В NameSpace().Items() я поставил вместо единички проверку на i#, полагая, что это счетчик добавленных файлов. Самое неприятное, что ошибка возникает не всегда и на разных архивируемых файлах. Если же после NameSpace().CopyHere() поставить Message(), то ошибка не возникает
Вопрос простой - где ошибка? Может кто делал уже подобное и наступал на эти грабли?

[Игорь Столяров]

Все здорово конечно, сразу хочу сказать что я этой задачей не занимался, но у меня сразу вопрос ...
А зачем для каждого файла делать "тяжелую" инициализацию и деактивацию объекта ?
Почему не попробовать просто создать объект, архив и добавлять туда файлы контролируя счетчик ?
На мой взгляд так было бы логичней ...

[soft42]

В смысле, в цикле оставить только CopyHere() и контроль Items() Вначале так и было. Не заметил разницы. Время на упаковку то-же самое.
Пока вышел из положения, закомментировав Loc:Object{Prop:ReportException} = True
Нет сообщения - нет проблем Файлы пакуются правильно в любом случае.