A way to ucompress a file using OLE without needing third party controls. Xp or better required.

0001  Function Uncompress_file(source_file, target_folder)
0002  /*
0003  **  Uncompress a file using Shell.Application
0004  **  Source file (in)=the file to uncompress e.g. \\myserver\mypath\compressed.zip
0005  **  target_folder=a folder to hold the results, e.g. \\myserver\mypath\uncompressed
0006  */
0007  
0008  declare function GetTemppath
0009  
0010  $insert Logical
0011  
0012  * Sehll.Application Options settings
0013  equ FSO_NODIALOG$ TO 4 ; *  Do not display a progress dialog box.
0014  equ FSO_YESTOALL$ TO 16; *  Respond with "Yes to All" for any dialog box that is displayed.
0015  
0016  if assigned(source_file) else source_file = ''
0017  if assigned(target_Folder) else target_folder = ''
0018  if source_file and target_folder else
0019     return ''
0020  end
0021  
0022  * Files exist?
0023  if dir(source_File)<1> Else
0024     return ''
0025  end
0026  
0027  if target_folder -1,1   = "\" else
0028     target_folder := '\'
0029  end
0030  
0031  if dir(target_folder)<2> else
0032     call MkDir(target_folder:\00\)
0033     if dir(target_folder)<2> else
0034        return ''
0035     end
0036  end
0037  
0038  oApp = OleCreateInstance("Shell.Application")
0039  source_Namespace = oApp->Namespace(source_file)
0040  target_nameSpace = oApp->Namespace(target_folder)
0041  
0042  options = FSO_NODIALOG$ + FSO_YESTOALL$ 
0043  source_items = source_Namespace->Items()
0044  x = Target_Namespace->CopyHere(source_items, options)
0045  
0046  return ''    

Hi Bob,

Brilliant thanks - that has certainly helped.

The only problem from this is that I do get the progress dialog displayed …

And the only follow-up question from the above code - does this mean that the shotrhand notation can now be used within procedures as well as events ??

Cheers,

Simon

progress dialog …

I have to use the 'this code is not supported / enhancements are left as an exercise for the student' dodge for that one.

does this mean that the shotrhand notation can now be used within procedures as well as events ?…

Sort of.

The arrow syntax in the system editor does is not the same thing in the event editor. For that reason most developers eschew its use.

The arrows in the event editor are only used for get / set property.

The arrows in the System Editor are only used for OLEGetProperty, OLEPutProperty and OLECallMethod. The arrow syntax for OLE is not conidered best practice

There is actually a precompiler in the event editor that swaps those back to get_property and set_property statements. It never passes the arrows to the Basic+ compiler. Thus, the event editor never passes the arrows to the Basic+ compiler.

The Basic+ compiler was enhanced to use the arrows as a shorthand for the OLE methods. The syntax simplifies the task of converting googled vbScript examples to Basic+ code, so I often use it. However, the syntax also causes confusion and means code from the system editor is not guaranteed to work in the function editor.

Thanks Bob,

Fair enough,

And thanks - I had guessed it might be something along those lines.

One quick other question as I have now tried a number of options, none of which seem to work. I create my unzipped data into a temporary directory to extract the details with the intent of deleting that directory after the event.

Is there an easy way to do that in one command, trying to use Utility Runwin doesn't seem to do anything no matter what switches I add to the CMD statement (or using RemoveDir). I dont really want to have to loop through each subdirectory to delete each set of files bit by but !!

Thanks,

Simon

The FileSystemObject can delete folders.

You could write something that looks like the code below.

Note: I used the technique in other programs but this example is just typed out, not compiled or tested.

0001  
0002      FSO = OleCreateInstance("Scripting.FileSystemObject")
0003      target_items = target_Namespace->Items()
0004      cnt = target_items->Count
0005      
0006      For i = 1 To cnt
0007         test_item = target_items->item(i-1)       
0008         test_path = test_item->path
0009         test_isfolder = test_item->IsFolder
0010         begin case
0011           case test_path = ''
0012              * Nothing to Delete
0013           case test_isfolder                    
0014              * Delete Folder
0015              x = FSO->deletefolder( test_path, true$)       
0016           case 1
0017              * Delete File
0018              x = FSO->deletefile( test_path)       
0019         end case
0020      next
0021      
0022       
0023  

Hi Bob,

Thanks for that - as it happens I only needed the deletefolder call as I create a temporary user folder for the work anyway. But have kept the code as a reference - and I am sure that this may prove useful to others as well !!

Meanwhile I am failing on the student exercise to hide the progress dialog. Checked the MSDN and the equate is correct, but it does state that these may not work outside of the 'C++ SHFILEOPSTRUCT' structure. I have tried hex and binary as well but no luck there either. It would be nice to be able to hide it, but if it cant be done I can live with it.

Thanks again,

Simon

Hi Bob,

I had this working - then tried to use various options settings to try and see if I could manage to hide that dialog box, now on the CopyHere command I get a message of 'File already exists', although that is most definitely not the case as the directory is deleted after attempt.

Can you have a quick look at the code below and see if you can see something stupid I have done ??

Or is it possible that I have managed to set something that I dont know how to unset (I have re-booted as a last resort to no avail).

Cheers,

Simon

Compile Subroutine Extract_Docx_Details(DocxFile)

$Insert Logical

$Insert User_Common

Declare Function Msg_Ps2000, Utility

Declare Subroutine CopyOSFile

Continue = True$

* – Shell.Application Options settings

Equ FSO_NoDialog$ to 4 ; * Do not display a progress dialog box.

Equ FSO_YesToAll$ to 16 ; * Respond with 'Yes to All' …

If Assigned(DocxFile) else DocxFile='

* – Initial check for new folders

TempDir = Drive() : '\WINWORD\2007TEMP'

If Dir(TempDir) else

 void	= Utility('MAKEDIR', TempDir)

 void	= Set_Status(0)

End

XMLDir = Drive() : '\WINWORD\2007XML'

If Dir(XMLDir) else

 void	= Utility('MAKEDIR', XMLDir)

 void	= Set_Status(0)

End

* – Check that the required data has been extracted or not.

FileName = DocxFile-1, 'B\'1, '.'

BaseDir = Drive() : '\WINWORD\2007XML\'

BaseFile = BaseDir : FileName : '.DATA'

TargetDir = Drive() : '\WINWORD\2007TEMP\' : User_Name%

SourceFile = TargetDir : '\' : FileName : '.ZIP'

BaseData = Dir(BaseFile)

DocxData = Dir(DocxFile)

If DocxData then

• – File exists

    Begin Case

       Case DocxData ] BaseData

• – Template had been updated since file last created

       Case DocxData 

• – Template not changed since file last created

          Continue	= False$

       Case DocxData ]= BaseData

• – Same date, time of Template indicates updates since file last created

       Case Otherwise$

• – By process of elimitation, same date but updated before last file creation

          Continue	= False$

 End Case

End else

• – No file - cant do anything

 Continue	= False$

 MsgText	= 'Docx ' : DocxFile : ' does not exist'

 void		= Msg_PS2000('M033', @Window, MsgText)

End

If Continue then

• – Create Temp Username directory

 void	= Utility('MAKEDIR', TargetDir)

 void	= Set_Status(0)

• – Copy docx file to zip file in Temp dir

 CopyOSFile(DocxFile, SourceFile, False$)

 void	= Set_Status(0)

• – Extract zip file into temp dir

 oApp	= OleCreateInstance('Shell.Application')

 Source_NameSpace	= oApp-]NameSpace(SourceFile)

 Target_NameSpace	= oApp-]NameSpace(TargetDir)

 void	= Set_Status(0)

• – Note that at the present time the No Dialog option does not work !!!

• – Tried various options - Hex, binary, ',' and ';' delimiters, all in quotes, negative numbers …

 Options	= FSO_NoDialog$ + FSO_YesToAll$

 Source_Items	= Source_NameSpace-]Items()

 Success	= Target_NameSpace-]CopyHere(Source_Items, Options)

 void		= Set_Status(0)

 If Success then

• – Get the header and merge field info and store separately

    DataFile			= ''

    OSRead SettingsData from TargetDir : '\WORD\SETTINGS.XML' then

       StartPos=Index(SettingsData, ''-1, 'B\'1,'"'

    End

    OSRead DocumentData from TargetDir : '\WORD\DOCUMENT.XML' then

       FieldData	= ''

       Cntr	= 1

       Loop

          StartPos	= Index(DocumentData, 'MERGEFIELD', Cntr)

       Until StartPos=0

          FldData	= DocumentDataStartPos, ]'

          Swap 'MERGEFIELD' with '' in FldData

          Swap '"' with '' in FldData

          Swap '"' with '' in FldData

          Swap ' ' with '' in FldData

          FieldData	= FldData

          Cntr	+= 1

       Repeat

    End

    DataFile	= HeaderData	: @fm : FieldData

    OSWrite DataFile to BaseFile

 End

• – Now delete the temp user dir and all contents

 FSO 	= OleCreateInstance('Scripting.FileSystemObject')

 void	= FSO-]DeleteFolder(TargetDir, True$)

End

Return

Further information :

I can create new docx merge templates and they work fine with new names.

I deleted and recreated a new doc with the same name I was having the problem with and this still causes a problem !!

Simon

And finally - the dialog box no longer appears on the newer files …

Obviously I managed to trigger something, but not sure what …

Simon

Simon,

Copyhere can leave junk in the windows tempp folder.

Check your windows temp folder (windows start run %TEMP% will show it)

Delete everything, or at least everything created when you were running your script, see if that fixes the problem.

Hi Bob,

Yes, that worked thanks - and still no sign of the dialog box :o)

Cheers,

Simon

View this thread on the Works forum...