unzip with Shell.Application ...

[bingo]

i'm looking for source code examples for unzip any zip with "Shell.Application" (winXP) like vbs :

Code: Select all

Const FOF_NOCONFIRMATION = &H10

Set objShell = CreateObject("Shell.Application")
Set SrcFldr = objShell.NameSpace("c:\tmp\test.zip")
Set DestFldr = objShell.NameSpace("c:\tmp\")

DestFldr.CopyHere SrcFldr.Items, FOF_NOCONFIRMATION

the pb-code like this:

Code: Select all

CoInitialize_(0)
If CoCreateInstance_(?CLSID_Shell,0,1,?IID_IShellDispatch,@Object.IShellDispatch) = 0
;Object\... ???
Object\Release()
EndIf
CoUninitialize_()

DataSection
CLSID_Shell:
Data.l $13709620
Data.w $C279,$11CE
Data.b $A4,$9E,$44,$45,$53,$54,$00,$00
             
IID_IShellDispatch:
Data.l $D8F015C0
Data.w $C278,$11CE
Data.b $A4,$9E,$44,$45,$53,$54,$00,$00
EndDataSection

it is a simple unzip way (no other res needed)

[Justin]

The method wrappers are because PB can't call methods that accept structures, so you have to go through all that fun..

you'll need another option flags for a silent operation.

now i wonder if it can also zip.

no error check, be sure to pass valid files.

Code: Select all

;Shell unzip
;Justin 04/05

#VT_BSTR = 8
#VT_DISPATCH = 9
#VT_I2 = 2

#DISPATCH_METHOD = 1

#FOF_NOCONFIRMATION = $10

Structure DISPPARAMS
	rgvarg.l            
	rgdispidNamedArgs.l 
	cArgs.l             
	cNamedArgs.l      
EndStructure 

Structure VARIANT
  vt.w
  wReserved1.w
  wReserved2.w
  wReserved3.w
  StructureUnion 
  	cVal.b							 				  	
  	iVal.w											  	
  	lVal.l												  	
  	bstrVal.l											
  	pdispVal.l							  	
  EndStructureUnion 
EndStructure

Procedure WCHAR(st$)
	blen = (lstrlen_(st$) * 2) + 10
	wbuf = AllocateMemory(blen)
	MultiByteToWideChar_(#CP_ACP, 0, st$, -1, wbuf, blen)
	ProcedureReturn wbuf
EndProcedure 

Procedure BSTR(st$)
	wst = WCHAR(st$)
	bstr = SysAllocString_(wst)
	FreeMemory(wst)
	ProcedureReturn  bstr	
EndProcedure

Procedure shNamespace(*osh.IUnknown, dir$)
	DISPID_Namespace = $60020002
	
	*osh\QueryInterface(?IID_IDispatch, @pDisp.IDispatch)
	
	;make arguments
	nArgs = 1
	rgvarg = AllocateMemory(SizeOf(VARIANT)*nArgs)
	*var.VARIANT = rgvarg
	
	;arg 1
	bdir = BSTR(dir$)
	*var\vt = #VT_BSTR
	*var\bstrVal = bdir
	
	rgdispidNamedArgs = AllocateMemory(SizeOf(LONG)*nArgs)
	*idarg.LONG = rgdispidNamedArgs
	*idarg\l = 0

	dp.DISPPARAMS
	dp\rgvarg = rgvarg
	dp\rgdispidNamedArgs = rgdispidNamedArgs
	dp\cArgs = nArgs
	dp\cNamedArgs = nArgs

	VarResult.VARIANT
	r = pDisp\Invoke(DISPID_Namespace, ?IID_NULL, #LOCALE_SYSTEM_DEFAULT, #DISPATCH_METHOD, @dp, @VarResult, #NULL, #NULL)
	pDisp\Release()
	FreeMemory(rgvarg)
	FreeMemory(rgdispidNamedArgs)
	FreeMemory(bdir)

	If r=#S_OK
		ProcedureReturn VarResult\pdispVal
	Else 
		ProcedureReturn 0
	EndIf 
EndProcedure 

Procedure fdCopyHere(*ofd.IUnknown, item, options)
	DISPID_CopyHere = $60020008
	*ofd\queryinterface(?IID_IDispatch, @pdisp.IDispatch)
	
	;make arguments
	Dim arg.VARIANT(2)
	Dim idarg(2)
	
	arg(0)\vt = #VT_DISPATCH
	arg(0)\pdispVal = item
	
	arg(1)\vt = #VT_I2
	arg(1)\iVal = options
	
	idarg(0) = 0 ;param 0 index
	idarg(1) = 1

	dp.DISPPARAMS
	dp\rgvarg = @arg(0)
	dp\rgdispidNamedArgs = @idarg(0)
	dp\cArgs = 2
	dp\cNamedArgs = 2

	;invoke
	VarResult.VARIANT
	r = pdisp\Invoke(DISPID_CopyHere, ?IID_NULL, #LOCALE_SYSTEM_DEFAULT, #DISPATCH_METHOD, @dp, @VarResult, #NULL, #NULL)
	pdisp\Release()
	ProcedureReturn r
EndProcedure 

;- #CODE START

CoInitialize_(0) 

CoCreateInstance_(?CLSID_Shell, 0, 1, ?IID_IShellDispatch, @osh.IShellDispatch)

inFile$ = "c:\test\test.zip"
outDir$ = "c:\test\unz\"

ofdSrc.Folder = shNamespace(osh, inFile$)
ofdDest.Folder = shNamespace(osh, outDir$)

ofdSrc\Items(@fdItems.FolderItems)

fdCopyHere(ofdDest, fdItems, #FOF_NOCONFIRMATION)

ofdSrc\release()
ofdDest\release()
fdItems\release()
osh\release()

CoUninitialize_()  

End

DataSection 
	CLSID_Shell: 
	Data.l $13709620 
	Data.w $C279,$11CE 
	Data.b $A4,$9E,$44,$45,$53,$54,$00,$00 
	              
	IID_IShellDispatch: 
	Data.l $D8F015C0 
	Data.w $C278,$11CE 
	Data.b $A4,$9E,$44,$45,$53,$54,$00,$00 
	
	IID_IDispatch:
	Data.l $00020400 
	Data.w $0000,$0000 
	Data.b $C0,$00,$00,$00,$00,$00,$00,$46
	
	IID_NULL:	
	Data.l $00000000 
	Data.w $0000,$0000 
	Data.b $00,$00,$00,$00,$00,$00,$00,$00
EndDataSection 

[bingo]

thanks

[Edwin Knoppert]

Yes thanks, the first example only accepts folders, maybe zip was treated as folder so i tried but i didn't get an object handle
Will soon try this one

[Edwin Knoppert]

Btw, you used the dispatch, maybe vtable access results in shorter code and slighty easier i think.

[Justin]

You can't use vtable,

HRESULT CopyHere(
[in] VARIANT vItem,
[in, optional] VARIANT vOptions);

PB can't call methods like these, they accept structures (VARIANT) , not pointers to structures. and PB can't pass structures to procedures, but i did not try it anyway.

Maybe Fred could find a fix for this. or if PB supported variable parameters in procs a generic procedure could be done to call any method or property.

[Edwin Knoppert]

To my knowledge pb can.
However, these may be long's having structure addresses.
Can't imagne it wouldn't work.

[Edwin Knoppert]

Most structures in Windows are passed byref, this means actually a dword-4 byte address.
So using pointers should be not problem.
vtable does not directly mean variants are used.

[Justin]

I think you don't understand the difference between this (C+)

HRESULT foo(
[in] VARIANT vItem);

and this

HRESULT foo(
[in] VARIANT* vItem);

the first method accepts a structure, the 2nd a pointer to a structure.PB can't pass structures, only pointers so calling the 1st will fail

other languages can pass structures as parameters, but this is not allowed in PB:

Procedure test(rc.RECT)
EndProcedure

[Bonne_den_kule]

Well, someone should post a request on the request forum

[Droopy]

Hello, this code can't be compiled with PB 4.60
Someone can fix it ?

[ABBKlaus]

just replace FreeMemory(bdir) with SysFreeString_(bdir)

[Droopy]

Thanks ABBKlaus.

is there a way to unzip silently ?