home *** CD-ROM | disk | FTP | other *** search
- ; WWWMENUS
- ; Common menus used by WWW Products
-
- CancelCmd="Exit"
- goto %param1% ; Go immediately to desired section
- ; Defined sections are:
- ZIP
- UNZIP
- SYSINFO
- INIEDIT
- FONEBOOK
- DIRSIZE
- FILEINFO
- FREESPACE
- FREESPACE2 (New Graphical version)
- CMDSTACK
- WALLPAPER
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :WALLPAPER
- a=strcat(CurrentPath(),CurrentFile()) ; Is a BMP file hilited?
- if FileExtension(a)=="BMP" then goto walldoit
- a=FileItemize("*.bmp") ; No? Any in Current Directory?
- if a!="" then goto sel
-
- ; Hmmm cannot find any BMP in current dir. Check INI/Prompt user for info
- WallDir1=inireadpvt("wallpaper","WallPaperDir","ASK","WWW-PROD.INI")
- :REASK
- if WallDir1=="ASK" then WallDir=AskLine("WallPaper","What directory are your *.BMP WallPaper files in?",DirWindows(0))
- else WallDir=WallDir1
- ErrorMode(@off)
- DirChange(WallDir)
- ErrorMode(@cancel)
- a=FileItemize("*.BMP")
- if a=="" then Message("WallPaper Error","No *.BMP files found in %WallDir%")
- then goto REASK
- if WallDir!=WallDir1 then iniwritepvt("wallpaper","WallPaperDir",WallDir,"WWW-PROD.INI")
-
- :sel
- a=strcat("-None- ",a)
- a=ItemSelect("Select New Wallpaper",a," ")
- terminate(a=="","Wallpaper","No wallpaper selected")
- if a=="-None-" then Wallpaper("",0)
- then exit
- a=strcat(DirGet(),a)
- :walldoit
- tile=@FALSE
- if FileSize(a)<40000 then tile=@TRUE
- ;if bmp size less than 40K, assume tile, else center
- Wallpaper(a,tile)
- drop(a,b,tile)
- Exit
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :CMDSTACK
- ; CmdStack uses wierd variable names to reduce the chance that a user
- ; will try to execute a statement using the same names!!
- if !IsDefined(CMDSTK987Cmds) Then CMDSTK987Cmds=""
- if !IsDefined(CMDSTK987Last) Then CMDSTK987Last="1+2+3"
- goto %param2%
-
- :PREVIOUS
- If CMDSTK987Cmds == "" Then Goto NEWCMD
- CMDSTK987Now = TextSelect("Select a command, or OK to enter a new command", CMDSTK987Cmds, @tab)
- If CMDSTK987Now != "" Then Goto CMDDOIT
- :NEWCMD
- CMDSTK987Now = AskLine("WIL Interactive", "Command to execute:", CMDSTK987Last)
- If CMDSTK987Now == "" Then Goto PREVIOUS
- :CMDDOIT
- Execute Message(CMDSTK987Now, %CMDSTK987Now%)
- if ItemLocate(CMDSTK987Now,CMDSTK987Cmds,@tab) then goto PREVIOUS
- a=@tab
- if CMDSTK987Cmds=="" then a=""
- CMDSTK987Cmds = StrCat(CMDSTK987Cmds, a, CMDSTK987Now)
- CMDSTK987Last = CMDSTK987Now
- Goto PREVIOUS
-
- :FLUSH
- If AskYesNo("Flush WIL command stack", "Really?") Then CMDSTK987Cmds = ""
- Exit
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :FREESPACE
- Drives=DiskScan(2) ; 2 is the code for local hard drives
- Dmax=strlen(Drives)
- DIndex=1
- TotalSize=0
- DriveReport=""
- madmax=0
- :COUNTSPACE
- NextDrive=StrSub(Drives,Dindex,1)
- a=DiskFree(NextDrive)/1024
- TotalSize=a+TotalSize
- DriveReport=strcat(DriveReport,NextDrive," = ",@tab,a,"K","@")
- DIndex=Dindex+3 ;each entry is 3 bytes long
- if DIndex<=Dmax then goto COUNTSPACE
- ItemSelect("Total Space Available = %TotalSize%K",DriveReport,"@")
- Drop(TotalSize,DriveReport,Drives,NextDrive)
- Exit
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :FREESPACE2
-
- inifile="www-prod.ini"
- inisection="DskSpace"
- Sort=inireadpvt(inisection,"Sort",1,inifile)
- LTGRAY="192,192,192"
- GRAY="128,128,128"
- DKGRAY="64,64,64"
- GREEN="0,255,0"
- PURPLE="255,0,255"
- BLACK="0,0,0"
- WHITE="255,255,255"
- BLUE="0,0,128"
- ErrorMode(@off)
- D3COLORX=RegQueryValue(@REGCURRENT,"Control Panel\colors[ButtonFace]")
- ErrorMode(@cancel)
- if D3COLORX!=0 then D3COLOR=D3COLORX
- else D3COLOR="192,192,192"
-
- ;Debug(1)
-
- ;Changed to IntControl(29)
- IntControl(29,@tab,0,0,0) ;Standardize on tabs so code runs in 16 and 32 bit
- BoxesUp("100,100,900,900",@Normal)
- Boxcolor(1,"192,192,192",4)
- boxdrawrect(1,"0,0,1000,1000",1)
-
- ;Initializing NoteId Box
- Noteid=4
- rectNote="50,800,490,890"
- BoxNew(Noteid,rectNote,1)
-
-
- BoxButtonDraw(1,1,"Alphabet","50,900,190,970")
- BoxButtonDraw(1,2,"FreeSpace","200,900,340,970")
- BoxButtonDraw(1,3,"TotalSize","350,900,490,970")
- BoxButtonDraw(1,4,"Exit","800,800,950,970")
- NoteHeight=400
- rectNoteText="50,200,950,800"
- rectnoteline1="0,0,1000,0"
- rectNoteline2="1000,1000,1000,0"
- rectNoteLine3="0,1000,1000,1000"
- rectNoteLine4="0,0,0,1000"
- notepenwidth=20
- rectnoteline1b="40,150,960,150"
- rectNoteline2b="960,840,960,150"
- rectNoteLine3b="40,840,960,840"
- rectNoteLine4b="40,150,40,840"
- notepenwidthb=10
- BoxColor(Noteid,D3COLOR,0)
- BoxDrawRect(Noteid,"",2)
- BoxPen(Noteid,WHITE,notepenwidth)
- boxdrawline(Noteid,rectNoteLine1)
- boxdrawline(Noteid,rectNoteLine4)
- BoxPen(Noteid,GRAY,notepenwidth)
- boxdrawline(Noteid,rectNoteLine2)
- boxdrawline(Noteid,rectNoteLine3)
- BoxPen(Noteid,WHITE,notepenwidthb)
- boxdrawline(Noteid,rectNoteLine2b)
- boxdrawline(Noteid,rectNoteLine3b)
- BoxPen(Noteid,GRAY,notepenwidthb)
- boxdrawline(Noteid,rectNoteLine1b)
- boxdrawline(Noteid,rectNoteLine4b)
-
- ;changed last param from 5 to 37
- BoxDrawText(Noteid,rectNoteText,"SORT BY:",1,37)
-
- BoxColor(1,BLUE,0)
- BoxDrawRect(1,"500,800,770,970",1)
- BoxTextColor(1,WHITE)
- BoxDrawText(1,"500,800,770,970","All measurements are in MegaBytes",1,21)
- BoxDataTag(1,"FRED")
-
-
- while @true
- ;debug(1)
- decimals(0)
- Drives=Diskscan(6)
- NumOfDrvs=ItemCount(Drives,@tab)
- matrix=binaryalloc(NumOfDrvs*24)
-
- for DIndex=1 to NumOfDrvs
- Drv=ItemExtract(DIndex,Drives,@tab)
- Drv=StrReplace(Drv,":","")
- f=(DiskFree(Drv)/1048576)
- s=(DiskSize(Drv)/1048576)
- binarypokestr (matrix,(DIndex-1)*24,Drv)
- binarypokeflt(matrix,(DIndex-1)*24+8,f)
- binarypokeflt(matrix,(DIndex-1)*24+16,s)
- next
-
- binarysort(matrix,24,16,8,@descending|@float8)
- biggest=binarypeekflt(matrix,16)
- switch sort ;(alphabet =1 Freespace=2 Totalsize=3)
- case 1
- binarysort(matrix,24,0,8,@ascending|@float8)
- Break
- case 2
- binarysort(matrix,24,7,8,@descending|@float8)
- Break
- case 3
- binarysort(matrix,24,16,8,@descending|@float8)
- Break
- EndSwitch
- If NumOfDrvs>6
- mult=350/biggest
- Vert=60
- Thick=25
- else
- mult=850/biggest
- tTab=50
- Vert=120
- Thick=50
- endif
- ;Debug(1)
- for ai= 1 to min(NumOfDrvs,26)
-
- if ai>13
- a=ai-13
- tTab=520
- else
- a=ai
- tTab=50
- endif
-
- ; Size
- size=binarypeekflt(matrix,(ai*24)-8)
- Boxcolor (1,PURPLE,0)
- Muscle=strcat(tTab,",",a*Vert,",",(size*mult)+tTab,",",(a*Vert)+Thick)
- BoxDrawRect(1,muscle,1)
- boxtextcolor(1,PURPLE)
- sinew=strcat((size*mult)+tTab,",",(a*vert),",",(size*mult)+tTab,",",(a*vert)+thick)
- boxdrawtext(1,sinew,"%size% total",@false,0)
- ; Free
- free=binarypeekflt(matrix,(ai*24)-16)
- Boxcolor (1,GREEN,0)
- bone=strcat(tTab,",",a*Vert,",",(free*mult)+tTab,",",(a*Vert)+Thick)
- BoxDrawRect(1,bone,1)
- marrow=strcat(tTab,",",(a*vert)+Thick+30,",",(size*mult)+tTab,",",(a*vert)+thick)
- boxtextcolor(1,GREEN)
- boxdrawtext(1,marrow,"%free% free",@false,0)
- ; Name
- name=binarypeekstr (matrix,(ai*24)-24,1)
- sinew=strcat(tTab-30,",",a*Vert,",",tTab,",",a*(Vert+Thick))
- boxtextcolor(1,D3COLOR)
- boxdrawtext(1,sinew,"%name%:",@false,0)
-
- next ai
- ; debug(1)
- BoxButtonWait()
- if BoxButtonStat(1,4)==1 then break
- If BoxButtonStat(1,1)==1 then sort=1
- If BoxButtonStat(1,2)==1 then sort=2
- If BoxButtonStat(1,3)==1 then sort=3
- BoxDataClear(1,"FRED")
- BoxUpdates(1,3)
- end while
- iniwritepvt(inisection,"Sort",Sort,inifile)
- exit
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :FILEINFO
- CancelCmd="goto cancelfi"
- a=FileItemize("")
- if a=="" then a=FileItemize("*.*")
- tot=FileSize(a)
- c=ItemCount(a," ")
- n=0
- b=""
- :ffloop
- if n==c then goto ffshow
- n=n+1
- a1=StrFix(ItemExtract(n,a," ")," ",14)
- a2=FileSize(a1)
- a3=FileTimeGet(a1)
- a4=FileAttrGet(a1)
- b=strcat(b,a1,@tab,a2,@tab,a3,@tab,a4,"|")
- goto ffloop
- :ffshow
- ItemSelect("Total Size=%tot%",b,"|")
- :cancelfi
- drop(a,tot,c,n,a1,a2,a3,a4,b)
- Exit
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :DIRSIZE
- tot = FileSize(FileItemize(""))
- sub1 = DirItemize("")
- if (tot==0 && sub1=="") then tot=FileSize(FileItemize("*.*"))
- then sub1=DirItemize("*.*")
- totdir=0
- level=1
- dir1=DirGet()
- numdir1 = ItemCount(sub1, " ")
- index1 = 0
-
- :dsloop
- If index%level% == numdir%level% Then Goto upalevel
- index%level% = index%level% + 1
- DirChange(StrCat(dir%level%, ItemExtract(index%level%, sub%level%, " ")))
- totdir=totdir+1
- tot = tot + FileSize(FileItemize("*.*"))
- level = level + 1
- dir%level% = DirGet()
- sub%level% = DirItemize("*.*")
- numdir%level% = ItemCount(sub%level%, " ")
- index%level% = 0
- goto dsloop
-
- :upalevel
- drop(dir%level%,sub%level%,index%level%,numdir%level%)
- level=level-1
- if level!=0 then goto dsloop
-
- ; -----------
- ; Termination
- ; -----------
- If StrLen(tot) < 9 Then tot = StrCat(StrFill("", 9 - StrLen(tot)), tot)
- tot = StrCat(StrSub(tot,1,3),",",StrSub(tot,4,3),",",StrSub(tot,7,3))
- tot = StrTrim(tot)
- If StrSub(tot, 1, 1) == "," Then tot = StrSub(tot, 2, StrLen(tot) - 1)
- tot = StrTrim(tot)
- If StrSub(tot, 1, 1) == "," Then tot = StrSub(tot, 2, StrLen(tot) - 1)
- tot = StrTrim(tot)
- Message("%totdir% Subdirectories included", "Total size %tot% bytes.")
- drop(tot,level,totdir)
- Exit
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :SYSINFO
- wintype="retail"
- if WinMetrics(22) then wintype="debug"
- wcx=WinMetrics(-3)
- math="Math"
- switch wcx
- case 0 ; Win16
- wc=WinConfig()
- if !(wc&1) then mode="Real"
- if wc&16 then mode="Standard"
- if wc&32 then mode="Enhanced"
-
- if wc&64 then cpu=8086
- if wc&128 then cpu=80186
- if wc&2 then cpu=286
- if wc&4 then cpu=386
- if wc&8 then cpu=486
- mode = strcat(mode,' ',wintype,' Windows ')
- if !(wc&1024) then math="No math"
- break
- case 1 ; Win32 Intel
- mode="Intel 32-bit %wintype% Windows "
- cpu= ItemExtract(6,WinSysInfo(),@tab)
- break
- case 2 ; Dec Alpha
- mode="DEC Alpha %wintype% Windows NT "
- cpu= ItemExtract(6,WinSysInfo(),@tab)
- break
- case 3 ; MIPS
- mode="MIPS %wintype% Windows NT "
- cpu= ItemExtract(6,WinSysInfo(),@tab)
- break
- case 4 ; PowerPC
- mode="PowerPC %wintype% Windows NT "
- cpu= ItemExtract(6,WinSysInfo(),@tab)
- break
- case wcx
- cpu= ItemExtract(6,WinSysInfo(),@tab)
- mode="Unknown platform %wintype% Windows "
- endswitch
-
- Sysinfo=strcat(cpu,' ',mode,WinVersion(1),'.',WinVersion(0),@CRLF)
-
- mouse="No Mouse"
- if WinMetrics(19) then mouse="Mouse"
-
- Sysinfo=strcat(sysinfo,math," co-processor. ",mouse,' available.',@CRLF)
-
- sysinfo=strcat(sysinfo,WinMetrics(0),'x',WinMetrics(1)," video resolution. ",WinMetrics(-1)," colors.",@CRLF)
-
- ErrorMode(@OFF)
- LastError()
- PlayMedia("Status WaveForm Ready")
- ErrorMode(@CANCEL)
- if LastError()!=1193 then sysinfo=strcat(sysinfo,"Windows multimedia extensions present.",@CRLF)
- a=NetInfo(0)
- if a=="MULTINET"
- b=NetInfo(1)
- bug=strcat(b,"network(s) installed"))
- ;Message("Multinet supporting %count% networks", b)
- else
- ;Message("Installed Network", a)
- bug=strcat(a," network installed")
- endif
- sysinfo=strcat(sysinfo,bug,@crlf)
-
-
- switch wcx
- case 0
- bug=WinResources(0)/1024 ; Compute memory avail
- math=strlen(bug)
- if math>3 then bug=strcat(strsub(bug,1,math-3),',',strsub(bug,math-2,3))
- sysinfo=strcat(sysinfo,@crlf,bug," KB Free Memory",@crlf)
- sysinfo=strcat(sysinfo,WinResources(2),"%% System Resources Free (",WinResources(3),"%% GDI, ",WinResources(4),"%% User)",@crlf)
- break
- case wcx
- bug=WinResources(11)/1024 ; Get Physical memory avail
- sysinfo=strcat(sysinfo,@crlf,bug," KB Physical Memory",@crlf)
- bug=(WinResources(14)/1024)+bug ; Get Virtual memory + Physical avail
- sysinfo=strcat(sysinfo,bug," KB Total Memory",@crlf)
- end switch
-
-
- sysinfo=strcat(sysinfo,"Console ",DosVersion(1),'.',DosVersion(0)," using ",environment("COMSPEC"),@CRLF)
- disks=DiskScan(1)
- disks=StrReplace(disks,@tab," ")
- if disks!="" then sysinfo=strcat(sysinfo,"Floppies ",disks,@CRLF)
- disks=DiskScan(2)
- disks=StrReplace(disks,@tab," ")
- if disks!="" then sysinfo=strcat(sysinfo,"Hard Disks ",disks,@CRLF)
- disks=DiskScan(4)
- disks=StrReplace(disks,@tab," ")
- if disks!="" then sysinfo=strcat(sysinfo,"Network Disks ",disks,@CRLF)
- sysinfo=strcat(sysinfo,"Windows Directory ",DirWindows(0),@CRLF)
- sysinfo=strcat(sysinfo,"System Directory ",DirWindows(1),@CRLF)
- sysinfo=strcat(sysinfo,@CRLF,"WIL Interpreter Ver ",VersionDll())
-
- ver=Version()
- Message("%Param2% %ver% SysInfo",Sysinfo)
- Exit
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :ZIP
- :UNZIP
- debug(1)
- CancelCommand="goto ZZCANCEL"
- ErrMsg=""
- If !FileExist("wwwdos.bat") Then ErrMsg="WWWDOS.BAT not found"
- If !FileExist("wwwdosp.pif") Then ErrMsg="WWWDOSP.PIF not found"
- If !FileExist("wwwdosc.pif") Then ErrMsg="WWWDOSC.PIF not found"
- If !FileExist("wwwzipls.exe") Then ErrMsg="WWWZIPLS.EXE not found"
- If !FileExist("pkzip.exe") Then ErrMsg="PKZIP.EXE not found"
- If !FileExist("pkunzip.exe") Then ErrMsg="PKUNZIP.EXE not found"
- If !FileExist("%FCDir789672%browser.exe") Then ErrMsg="%FCDir789672%BROWSER.EXE not found"
- If ErrMsg!="" Then Goto ShowError
-
- goto %param1%2 ; must be ZIP or UNZIP
-
- :ZIP2
- DaMove=" -a "
- DaDirs=""
- DaWho="*.*"
- DaZip=""
- DaRefresh=0
- DaTitle="Files"
- param3=strlower(param3)
- if param3=="move" then DaMove=" -m "
- goto %param2% ; Must be CURRENT, DIR, SUBDIR, or HILITED
-
- :CURRENT
- DaWho=strcat(CurrentPath(),CurrentFile())
- DaZip=strcat(FileRoot(DaWho),".ZIP")
- goto ZIPDO
- :SUBDIR
- DaDirs=" -r -p "
- DaRefresh=1
- DaTitle="Structure"
- goto ZIPDO
-
- :HILITED
- b=FileItemize("")
- If b=="" Then ErrMsg="Zip Hilited files? No files hilited!"
- Then Goto ShowError
- b=strreplace(b," ",@CRLF)
- fp=FileOpen("FC-TEMP9.XCV","WRITE")
- FileWrite(fp,b)
- FileClose(fp)
- Drop(b)
- DaWho="@FC-TEMP9.XCV"
- goto ZIPDO
-
- :DIR
- DaTitle="Directory"
- goto ZIPDO
-
- :ZIPDO
- DaZip=AskLine("Zip %DaTitle%","Enter desired ZIP name",DaZip)
- if DaZip=="" then goto zzcancel
- Runwait("wwwdosc.pif","pkzip.exe %DaMove% %DaDirs% %DaZip% %DaWho%")
- if DaWho=="FC-TEMP9.XCV" then FileDelete(DaWho)
- Refresh(DaRefresh)
- Display(3,"Zip %DaTitle%","Complete")
- goto zzcancel
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :UNZIP2
-
- ViewFlag=0
- zipsort=param3
- goto %param2% ; must be ALL, VIEW, or INDIV
-
- :ALL
- zipfile=strcat(CurrentPath(),CurrentFile())
- if FileExtension(zipfile)=="ZIP" then goto alldoit
- zipfile=FileItemize("*.zip")
- If zipfile=="" Then ErrMsg="UnZip files? No zip files found!"
- Then Goto ShowError
- zipfile=itemselect("Select file to UnZip",zipfile," ")
- if zipfile=="" then goto zzcancel
- :alldoit
- if param3==2 then goto allspec
- runwait("wwwdosc.pif","pkunzip.exe -d %zipfile%")
- Refresh(1)
- goto zzcancel
-
- :allspec
- RetHome="allspec1"
- goto DoOptions
- :allspec1
- if overwarn==0 then overwarn=" -o "
- else overwarn=""
- RunWait("wwwdosc.pif", "pkunzip.exe -d %overwarn% %zipfile% %targdir% *.*")
- Refresh(1)
- goto zzcancel
-
-
-
- :INDIV
- ViewFlag=param3
- if ViewFlag==1 then zipsort=1
- then overwarn=0
- then targdir=""
- then goto VIEW
-
- RetHome="VIEW"
- goto DoOptions
-
- :VIEW
- workdir = Environment("TEMP")
- If workdir == "" Then workdir = DirWindows(0)
- If StrSub(workdir, StrLen(workdir), 1) != "\" Then workdir = StrCat(workdir, "\")
- if ViewFlag==0 then targdir=workdir
- zipfile=strcat(CurrentPath(),CurrentFile())
- if FileExtension(zipfile)=="ZIP" then goto viewdoit
- zipfile=FileItemize("*.zip")
- If zipfile=="" Then ErrMsg="UnZip files? No zip files found!"
- Then Goto ShowError
- if ViewFlag==0 then TSMsg="Select ZIP file to view"
- else TSMsg="Select ZIP file to use"
- zipfile=itemselect(TSMsg,zipfile," ")
- if zipfile=="" then goto zzcancel
-
- :viewdoit
- ziplist = StrCat(workdir, "wwwunzip.lst")
- If FileExist(ziplist) Then FileDelete(ziplist)
-
- RunWait("wwwzipls.exe","%zipfile% %ziplist% %zipsort%")
- if ViewFlag==0 then TSMsg="Select file to view"
- else TSMsg="Select file to extract"
- :TXSEL
- OldFont=IntControl(28,1,0,0,0) ; Set fixed pitch font in text box
- member=TextBox(TSMsg,ziplist)
- IntControl(28,OldFont,0,0,0) ; Restore previous font pitch type
- if member=="" then goto ZZCANCEL
-
- member=strsub(member,46,strlen(member)-45)
- memfile=FileExtension(member)
- if memfile!="" then memfile=strcat(FileRoot(member),".",memfile)
- else memfile=FileRoot(member)
-
-
- if ViewFlag==0 then goto extract
- if overwarn==0 then goto extract
- If FileExist("%targdir%%memfile%") == @FALSE Then Goto extract
- b= AskYesNo("%member% already exists in %targdir%", "Do you wish to replace it?")
- If b == @NO Then Goto TXSEL
-
- :extract
- RunWait("wwwdosc.pif", "pkunzip.exe -o %zipfile% %targdir% %member%")
- If !FileExist("%targdir%%memfile%") Then ErrMsg="Problem extracting %member% from ZIP file"
- Then Goto ShowError
-
- if ViewFlag!=0 then TSMsg="Extract Another?"
- then goto TXSEL
- member = StrUpper(StrCat(targdir, memfile))
- RunZoomWait("%FCDir789672%browser.exe", member)
- FileDelete(member)
- TSMsg="View Another?"
- goto TXSEL
-
-
- :SHOWERROR
- Message("Error", ErrMsg)
-
- :ZZCANCEL
- if IsDefined(ziplist) then If FileExist(ziplist) Then FileDelete(ziplist)
- Drop(DaMove,DaDirs,DaWho,DaZip,DaRefresh,DaTitle,ViewFlag,zipsort)
- Drop(zipfile,b,RetHome,overwarn,targdir,workdir,ziplist,TSMsg,member)
- Drop(ErrMsg,usecurdir,ThisDir,CheckDir,memfile)
- Drop(ZippyFormat,ZippyCaption,ZippyX,ZippyY,ZippyWidth,ZippyHeight)
- Drop(ZippyNumControls,Zippy01,Zippy02,Zippy03,Zippy04,Zippy05,Zippy06)
- Drop(Zippy07,Zippy08,Zippy09,Zippy10,Zippy11,Zippy12,Zippy13)
- exit
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- :DOOPTIONS
- zipsort = IniReadPvt("WWWUNZIP", "SortOrder", 1, "www-prod.ini")
- overwarn=IniReadPvt("WWWUNZIP","OverWarn",1,"www-prod.ini")
- whichdir=IniReadPvt("WWWUNZIP","WhichDir",1,"www-prod.ini")
-
- ; Undocumented, new, beta dialog function being used here. Will
- ; be documented in the 2.0 release. Good Luck.
-
-
- ZippyFormat=`WWWDLGED,4.0`
-
- ZippyCaption=`Zip Options`
- ZippyX=-1
- ZippyY=-1
- ZippyWidth=217
- ZippyHeight=115
- ZippyNumControls=13
- Zippy01=`6,18,80,DEFAULT,RADIOBUTTON,whichdir,"Use Current Dir ->",1`
- Zippy02=`6,32,80,DEFAULT,RADIOBUTTON,whichdir,"Use Specified Dir ->",2`
- Zippy03=`86,32,124,DEFAULT,EDITBOX,targdir,""`
- Zippy04=`16,64,56,DEFAULT,RADIOBUTTON,zipsort,"by Name",1`
- Zippy05=`16,76,58,DEFAULT,RADIOBUTTON,zipsort,"by Extension",2`
- Zippy06=`16,88,46,DEFAULT,RADIOBUTTON,zipsort,"by Date",3`
- Zippy07=`16,100,46,DEFAULT,RADIOBUTTON,zipsort,"by Size",4`
- Zippy08=`108,58,80,DEFAULT,CHECKBOX,overwarn,"Warn on Overwrite",1`
-
- Zippy09=`120,78,64,DEFAULT,PUSHBUTTON,DEFAULT,"&Ok",1`
- Zippy10=`120,98,64,DEFAULT,PUSHBUTTON,DEFAULT,"&Cancel",0`
- Zippy11=`6,4,64,DEFAULT,STATICTEXT,NONAME,"Target Directory"`
- Zippy12=`6,52,64,DEFAULT,STATICTEXT,NONAME,"Sort list by:"`
- Zippy13=`88,20,122,DEFAULT,VARYTEXT,ThisDir,""`
-
-
- :gettarg
- ; Undocumented, new, beta dialog function being used here. Will
- ; be documented in the 2.0 release. Good Luck.
- ThisDir=DirGet()
- targdir = IniReadPvt("WWWUNZIP", "TargetDir", DirGet(), "www-prod.ini")
- Dialog("Zippy")
-
- if whichdir==1 then usecurdir = @YES
- then targdir=ThisDir
- else usecurdir = @NO
- targdir = StrUpper(targdir)
- If targdir == "" Then usecurdir = @YES
- Then targdir = DirGet()
- If StrSub(targdir, StrLen(targdir), 1) != "\" Then targdir = StrCat(targdir, "\")
- If ThisDir==targdir then usecurdir = @YES
- then goto targok
- DirChange(targdir)
- CheckDir=DirGet()
- DirChange(ThisDir)
- If ThisDir!=CheckDir Then Goto targok
-
- b= AskYesNo("WWWUNZIP", "%targdir% does not exist. Do you wish to create it?")
- If b == @NO Then Goto gettarg
- DirMake(targdir)
- DirChange(targdir)
- CheckDir=DirGet()
- DirChange(ThisDir)
- If ThisDir!=CheckDir Then Goto targok
- Message("WWWUNZIP","%targdir% could not be created. Please respecify.")
- goto gettarg
-
- :targok
- If usecurdir == @NO Then IniWritePvt("WWWUNZIP", "TargetDir", targdir, "www-prod.ini")
- IniWritePvt("WWWUNZIP", "SortOrder", zipsort, "www-prod.ini")
- IniWritePvt("WWWUNZIP", "OverWarn", overwarn, "www-prod.ini")
- IniWritePvt("WWWUNZIP", "WhichDir", whichdir, "www-prod.ini")
- goto %RetHome%
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- :CANCEL ; This cancel is shared by ALL the above routines.
- %CancelCmd% ; Execute Cancel Command
-