home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / PKB / MAKEZIP.PRG < prev    next >
Text File  |  1993-01-30  |  12KB  |  313 lines
  1. /*┌──────────────────────────────────────────────────────────────────────┐
  2.  ▌│                                                                      │
  3.  ▌│ Program Name: MAKEZIP.PRG       Copyright: Gallagher Computing Corp. │
  4.  ▌│ Date Created: 11/30/92           Language: Clipper 5.0               │
  5.  ▌│ Time Created: 15:19:04             Author: Kevin S Gallagher         │
  6.  ▌│                                                                      │
  7.  ▌│      Purpose: Compress source code into a Zip File for any reason.   │
  8.  ▌│                                                                      │
  9.  ▌│   Directives: Many are useful while others are to keep commands on   │
  10.  ▌│               one line, instead of make more than one line of code   │
  11.  ▌│                                                                      │
  12.  ▌│    Libraries: NANFOR.LIB                                             │
  13.  ▌│               FT_SINKEY() - replaces INKEY()            - replacable │
  14.  ▌│               MENU TO     - Enchanced MENU TO command   - optional   │
  15.  ▌│               BLINKER     - SWAP FUNCTIONS              - required   │
  16.  ▌│                                                                      │
  17.  ▌│                                                                      │
  18.  ▌│    ZipTest(): This function is used with Blinkers Swap function to   │
  19.  ▌│               evaluate PKzip v2.00 error return codes.               │
  20.  ▌└──────────────────────────────────────────────────────────────────────┘
  21.  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀           */
  22. #include "makezip.h"
  23.  
  24. //── Fill this array with files in other directories that are needed for
  25. //── creating application ie. any obj's, program editor config files
  26. static nHandle :=0, Stable := {"C:\BRIEF\STATE.RST"}, aFiles_:={}
  27.  
  28. function main()
  29.     local nAsk, i
  30.     IF FILE(IF(PCOUNT()<>0,ZIPFILE,zipname()+".ZIP"))
  31.         nAsk:=alert("FRESHEN ZIPFILE?",{" Yes ", " No "})
  32.         if nAsk = 1
  33.             @0,0 SAY PADR(" FRESHEN "+ZIPFILE,80) color "N/BG"
  34.             SwpRunCmd(PKF+IF(PCOUNT()<>0,ZIPFILE,zipname())+" >NUL ", 0,"")
  35.             ZipTest( SWPERRLEV() )
  36.             @0,0 say PADC("OPERATION COMPLETED SUCCESSFULLY",80) color "W/B"
  37.             QUIT
  38.         else
  39.             @0,0 SAY PADC("OPERATION ABORTED",80) color "W+*/R"
  40.             QUIT
  41.         endif
  42.     ENDIF
  43.     //─── Make List file for compressing files
  44.     IF ( nHandle:= fcreate(INIFILE,FC_NORMAL)) =-1
  45.         ALERT("ERROR CREATING "+INIFILE)
  46.         QUIT
  47.     ENDIF
  48.     aFiles_ :=listext()                          // get valid extensions
  49.     aFiles_ :=TBMenu(aFiles_)                    // select .ext to compress
  50.     AEVAL( aFiles_, cBlock  )
  51.     //─── Execute next routine only if we have something to do!
  52.     IF LEN(Stable) <> 0
  53.         AEVAL( Stable, dBlock  )
  54.     ENDIF
  55.     fclose(nHandle)
  56.     nAsk:=alert("Edit pklist file",{" Yes ", " No "})
  57.     if nAsk = 1
  58.         EditText(INIFILE, .T.)
  59.     endif
  60.     
  61.     IF FILE(C_FILE)
  62.         nAsk := alert("Edit comments for zipfile", {" Yes ", " No "} )
  63.         if nAsk = 1
  64.             EditText(C_FILE, .T.)
  65.         endif
  66.     ELSE
  67.         nAsk := alert("Create comments for zipfile", {" Yes ", " No "} )
  68.         if nAsk = 1
  69.             IF ( nHandle:= fcreate(C_FILE,FC_NORMAL)) =-1
  70.                 ALERT("ERROR CREATING "+C_FILE)
  71.                 QUIT
  72.             ENDIF
  73.             nHandle := fcreate(C_FILE,FC_NORMAL)
  74.             EditText(C_FILE, .T.)
  75.         endif
  76.     ENDIF
  77.  
  78.     @0,0 say PADR(" CREATING NEW ZIPFILE",80) color "W+/RB"
  79.     SwpRunCmd(PKZ+IF(PCOUNT()<>0,ZIPFILE,zipname())+" >NUL @"+INIFILE, 0,"")
  80.     ZipTest( SWPERRLEV() )
  81.     if file(C_FILE)
  82.         nHandle:= FOPEN(C_FILE,0)
  83.         IF FERROR() == 0 .AND. FSEEK(nHandle,0,2) > 3
  84.             FCLOSE(nHandle)
  85.         ENDIF
  86.         SwpRunCmd(PKZ+IF(PCOUNT()<>0,ZIPFILE,zipname())+" -z < "+C_FILE,0,"")
  87.         ZipTest( SWPERRLEV() )
  88.     endif
  89.  
  90.     #ifdef KILL_UM
  91.     IF FERASE(INIFILE) =-1
  92.         ALERT("ERROR REMOVING "+INIFILE)
  93.         QUIT
  94.     ENDIF
  95.     IF FILE(C_FILE)
  96.         IF FERASE(C_FILE) =-1
  97.             ALERT("ERROR REMOVING "+C_FILE)
  98.             QUIT
  99.         ENDIF
  100.     ENDIF
  101.     #endif
  102.     clearme()
  103.     @0,0 say PADR(" OPERATION COMPLETED SUCCESSFULLY",80) color "W+/RB"
  104. return nil
  105.  
  106. function WriteIt(cFile)
  107.     FWriteLine(nHandle,cFile)
  108. return nil
  109.  
  110. function EditText(cFileName, lEditMode)
  111.    local cBuf, lWrite :=.F., oldcolor :=setcolor("w/b"), nCurs :=setcursor(1)
  112.    lEditMode :=.T.
  113.    cBuf := MEMOREAD(cFileName)
  114.    @00,00 say PADR("Edit: "+ cFileName,80)                    color "w+ /bg"
  115.    @MR,00 say PADR(" F2 = Save/Exit   F10 = Abort/Exit",80)   color "n  /bg"
  116.    @MR,60 say "Line:       Col:"                              color "gr+/bg"
  117.    readinsert(.T.)
  118.    cBuf := MEMOEDIT(cBuf,1,0,MR-1,79,lEditMode, "MemoUDF", 250)
  119.    if lastkey() = K_F2
  120.       lWrite := MEMOWRIT( rtrim(cFileName), cBuf )
  121.    endif
  122.    readinsert(.F.)
  123.    SETCOLOR(oldcolor)
  124.  
  125.    IF lEditMode
  126.        setcursor(nCurs)
  127.    ENDIF
  128.    clearme()
  129. return nil
  130.  
  131. function MemoUDF( nMode, nLin, nCol )
  132.    local nKey, nRval:=0
  133.  
  134.    nKey := LASTKEY()
  135.    IF nMode == 0
  136.       @MR,66 say nLin picture "9999" color "w+/bg"
  137.       @MR,77 say nCol picture "999"  color "w+/bg"
  138.    ELSEIF nMode == 1 .OR. nMode == 2
  139.       do case
  140.           case nKey == K_F10
  141.               nRval := 27
  142.           case nKey == K_F2
  143.               nRval := 23
  144.       endcase
  145.    ENDIF
  146. return (nRval)
  147.  
  148.  
  149. FUNCTION zipname
  150. Return STRTRAN(;
  151. IF(MONTH(DATE()) < 10, "0" + STR(MONTH(DATE()),1), STR(MONTH(DATE()),2)) - ;
  152. IF( DAY(DATE())  < 10, "0" + STR(DAY(DATE()),1  ), STR(DAY(DATE())    )) - ;
  153. STR(YEAR(DATE()))," ","")
  154.  
  155. function ZipTest( nParm )
  156.     local nErr :=0
  157.     local aArray_:={;
  158.     "01 R/O ATTRIBUTES;DIR FULL;NETWORK ERROR",                            ;
  159.     "02 ERROR IN ZIPFILE" ,                                                ;
  160.     "03 ERROR IN ZIPFILE" ,                                                ;
  161.     "04 INSUFFICIENT MEMORY" ,                                             ;
  162.     "05 INSUFFICIENT MEMORY" ,                                             ;
  163.     "06 INSUFFICIENT MEMORY" ,                                             ;
  164.     "07 INSUFFICIENT MEMORY" ,                                             ;
  165.     "08 INSUFFICIENT MEMORY" ,                                             ;
  166.     "09 INSUFFICIENT MEMORY" ,                                             ;
  167.     "10 INSUFFICIENT MEMORY" ,                                             ;
  168.     "11 INSUFFICIENT MEMORY" ,                                             ;
  169.     "12 NOTHING TO FRESHEN;OR;WRONG COMMAND PARAMETERS USED",              ;
  170.     "13 FILE DOES NOT EXIST;OR;POSSIBLE DOS I/O ERROR" ,                   ;
  171.     "14 INSUFFICIENT DISKSPACE;OR;DISK FULL." ,                            ;
  172.     "15 FAILED TO OPEN FILE FOR WRITE ACCESS" ,                            ;
  173.     "17 ATTEMPT TO COMPRESS TO MANY FILES;OR;CORRUPT FILE HEADER" ,        ;
  174.     "24 FATAL EMS ERROR" ,                                                 ;
  175.     "25 FATAL EMS ERROR" ,                                                 ;
  176.     "26 DOS 3.0 OR LATER NEEDED TO SPAN DISKS" ,                           ;
  177.     "27 NON-REMOVABLE;OR;UNSUPPORTED DEVICE"                               }
  178.  
  179.     nErr := ASCAN(aArray_,sBlock)
  180.  
  181.     IF nErr == 0
  182.         return nil
  183.     ENDIF
  184.     ALERT( IF( nErr <> 0, SUBS(aArray_[nErr],4),"Unknow Error"),{" QUIT "} )
  185.     QUIT 
  186. return nil
  187.  
  188. function clearme
  189.     local i,y,oldcur:=setcursor(0)
  190.     for i = 0 to maxrow()
  191.         scroll(i,0,i,maxcol(),0)
  192.         //─── delay rate
  193.         inkey(.1)
  194.     next
  195.     setcursor(oldcur)
  196. return nil
  197.  
  198.  
  199. INIT function haha
  200.    set(_SET_SCOREBOARD,.F.)
  201. return nil
  202.  
  203. function TBMenu(aExt_,                                                     ;
  204.                 nBoxType,                                                  ;
  205.                 cBoxColor,                                                 ;
  206.                 cTextColor,                                                ;
  207.                 cColors,                                                   ;
  208.                 cButtColor,                                                ;
  209.                 lShadow,                                                   ;
  210.                 nShadColor                                                 )
  211.  
  212.     local oldcolor := setcolor(), aTemp_:={}, a_ :={}, b, c, nEle := 1, i, ;
  213.     nLen :=0, nKey, oldscrn, oldcursor := setcursor(0), nWhich :=1, nAtt:= 0
  214.     
  215.     aExt_      := if(ValType(aExt_)      = "A" , aExt_,{})
  216.     nBoxType   := if(ValType(nBoxType)   = "N" , nBoxType,1)
  217.     cBoxColor  := if(ValType(cBoxColor)  = "C" , cBoxColor,   "W+ /B")
  218.     cTextColor := if(ValType(cTextColor) = "C" , cTextColor,  "W+ /B")
  219.     cColors    := if(ValType(cColors)    = "C" , cColors,"W+/B,W+/RB")
  220.     cButtColor := if(ValType(cButtColor) = "C" , cButtColor,"N/W,W+/BG")
  221.     lShadow    := if(ValType(lShadow)    = "L" , lShadow,.T.)
  222.     nShadColor := if(ValType(nShadColor) = "N" , nShadColor,5)
  223.  
  224.     if Empty(aExt_)
  225.         return nil
  226.     endif
  227.  
  228.     oldscrn := savescreen(0,0,MR,MC)
  229.     CLS2(113,"ZipMaker ")
  230.     @0,0 say PADC("SPACEBAR TO SELECT - ENTER TO CONTINUE",80) color cColors 
  231.     set(_SET_WRAP,.T.)
  232.     setcolor(cTextColor)
  233.     nLen  := LEN(aExt_)
  234.     aTemp_:= ARRAY(nLen)
  235.     AFILL( aTemp_,"X")
  236.  
  237.     b:=TBrowseNew(9,34,14,48)
  238.     b:colorSpec     := cColors
  239.     b:colSep        := ""
  240.     b:goTopBlock    := { ||  nEle:=1 }
  241.     b:goBottomBlock := { ||  nEle:=nLen }
  242.     b:SkipBlock     := { |n| ArrSkipper( nLen, @nEle, n) }
  243.     c:=TBColumnNew(,   { ||  aTemp_[nEle] } )
  244.     c:width:=1
  245.     b:AddColumn( c )
  246.     c:=TBColumnNew(,   { ||  aExt_[nEle] } )
  247.     b:colSep        := "  ══ "
  248.     c:width:=8
  249.     b:AddColumn( c )
  250.  
  251.     dispbox(6,24,16,53,BOXTYPE[ nBoxType ],cBoxColor)
  252.     if lShadow
  253.         #ifdef NANNY
  254.            FT_SHADOW(6,24,16,53,5) // nShadColor)
  255.         #endif
  256.     endif
  257.     WHILE .T.
  258.        STABILIZE b
  259.        nEle := if(b:hittop()   ,   1,nEle)
  260.        nEle := if(b:hitbottom(),nLen,nEle)
  261.        if b:stabilize()
  262.            @7,28 say PADC(LSTRINT(nEle)+"/"+LSTRINT(nLen),22) color cColors
  263.            nKey:=FT_SINKEY(0)
  264.        endif
  265.        DO CASE
  266.           CASE nKey == K_UP    ; b:up()
  267.           CASE nKey == K_DOWN  ; b:down()
  268.           CASE nKey == K_SPACE
  269.              aTemp_[nEle] := IF("X" $ aTemp_[nEle]," ","X")
  270.              b:refreshall()
  271.           CASE nKey == K_ENTER .OR. nKey == K_ESC .OR. nKey == K_PGDN
  272.              @15,31  PROMPT " Custom "          COLOR cButtColor
  273.              @15,43  PROMPT " All "             COLOR cButtColor
  274.              MENU TO nWhich
  275.              restscreen(0,0,MR,MC,oldscrn)
  276.              
  277.              if nWhich == 1
  278.                  FOR i = 1 TO nLen
  279.                      IF(aTemp_[i] == "X", AADD(a_,aExt_[i]), NIL )
  280.                  NEXT
  281.                  aTemp_:=ACLONE(a_)
  282.              else
  283.                  aTemp_:=ACLONE(aExt_)
  284.              endif
  285.              EXIT
  286.       ENDCASE
  287.     ENDDO
  288.     setcolor( oldcolor )
  289.     setcursor( oldcursor )
  290. return aTemp_
  291.  
  292. function ArrSkipper( aLen, curPos, howmany )
  293.    local actual
  294.    if howmany >=0
  295.       if (curPos+howmany) > aLen
  296.          actual := alen-curpos
  297.          curpos := alen
  298.       else
  299.          actual := howmany
  300.          curpos += howmany
  301.       endif
  302.    else
  303.       if (curPos+howmany) < 1
  304.          actual := 1-curPos
  305.          curPos := 1
  306.       else
  307.          actual := howmany
  308.          curPos += howmany
  309.       endif
  310.    endif
  311. return actual
  312.  
  313.