Hi there,
Just posted a bit of sourcecode at: http://www.powerbasic.com/support/forums/Forum7/HTML/001789.html
It's a very crude template/sample to write Total Commander packer plugins.
The .wcx files are actually dlls with a different extension.
I couldn't find any powerbasic source for this so I created my own,
the sample is placed in the public domain, feel free to take it apart.
Filesystem (WFX) and Lister (WLX) plugins are planned, and I will post them once I figure something useful.
Also a better packer source will be posted that supports creating/updating as well if I can think of a good archive format to support
I'd appreciate any feedback, on the forum, or by email (in source).
If you come up with an improvement to the sample please post it for others to learn from as well.
Thanks,
Jeroen.
Code: Select all
The indentation is okay, but for some reason when it displays the message it's gone.
'===============================================================================
'
' PowerBasic Template/Sample for Total Commander's Pack plug-in (.wcx)
' by Jeroen van Rijn (bytalized)
' email comments (and plugins you used the template for) to:
' bytalize@xs4all.nl
' Hereby placed in the Public Domain
'
' Total Commander Copyright © 1993-2003 by Christian Ghisler, C. Ghisler & Co.
' All Rights Reserved.
'
' PowerBasic is a registered trademark of PowerBasic, Inc.
'
' Note: Check out the addons section at http://www.ghisler.com for the full API
'
' What's it do? It reads .bas source files (PowerBasic), and returns the
' functions and subs as file, nothing interesting.
'
' Known limitations:
' Will read VB modules, but creates weird file list when the Public keyword
' is used, e.g. PUBLIC SUB Name (Param AS Type)
' Weird file list when no subs or functions are present
'
' Version 0.0.1 - 05/03/2003
'
' No warranties of any kind are given or implied.
'
' Future, maybe:
' - Fix VB parsing
' - Process includes
' - Add \CONSTANT
' - Add \GLOBAL
' - Add \TYPE
' - Add \DECLARE
' - Maybe do something useful with the subs and functions, like generating
' comments at the top, i.e.
' 'Function name: Something
' 'Input: sVar1 AS STRING
' 'Input: lVar2 AS LONG
' 'Output: DWORD
' 'Comment: Fill this in after using this 'packer'
' FUNCTION Something (sVar1 AS STRING, lVar2 AS LONG) AS DWORD
' - Maybe export altered source, like filename.hung.bas, auto-Hungarian:
' GLOBAL SomeVar AS STRING ->
' GLOBAL gsSomeVar AS STRING
' or filename.sorted.bas with all subs and functions sorted alphabetically
'
' Future, definite:
' Once I figure out a useful archive format that's not been made into a TC
' plugin I'll create a plugin with packing capabilities as well to show
' all Total Commander WCX API functions.
'
' If I can think of a filesystem that hasn't been done I'll create a Filesystem
' (wfx) plugin source as well.
'
' Same goes for the lister plugin (wlx)
'
'===============================================================================
#DIM ALL
#COMPILE DLL "bas.dll"
#INCLUDE "WIN32API.INC"
'== Constants ==================================================================
'==== Error codes returned to calling application ==============================
%E_END_ARCHIVE = 10 ' No more files in archive
%E_NO_MEMORY = 11 ' Not enough memory
%E_BAD_DATA = 12 ' Data is bad
%E_BAD_ARCHIVE = 13 ' CRC error in archive data
%E_UNKNOWN_FORMAT = 14 ' Archive format unknown
%E_EOPEN = 15 ' Cannot open existing file
%E_ECREATE = 16 ' Cannot create file
%E_ECLOSE = 17 ' Error closing file
%E_EREAD = 18 ' Error reading from file
%E_EWRITE = 19 ' Error writing to file
%E_SMALL_BUF = 20 ' Buffer too small
%E_EABORTED = 21 ' Function aborted by user
%E_NO_FILES = 22 ' No files found
%E_TOO_MANY_FILES = 23 ' Too many files to pack
%E_NOT_SUPPORTED = 24 ' Function not supported
' flags for unpacking
%PK_OM_LIST = 0
%PK_OM_EXTRACT = 1
' flags for ProcessFile
%PK_SKIP = 0 ' Skip this file
%PK_TEST = 1 ' Test file integrity
%PK_EXTRACT = 2 ' Extract to disk
' Flags passed through ChangeVolProc
%PK_VOL_ASK = 0 ' Ask user for location of next volume
%PK_VOL_NOTIFY = 1 ' Notify app that next volume will be unpacked
' Flags for packing
' For PackFiles
%PK_PACK_MOVE_FILES = 1 ' Delete original after packing
%PK_PACK_SAVE_PATHS = 2 ' Save path names of files
' Returned by GetPackCaps
%PK_CAPS_NEW = 1 ' Can create new archives
%PK_CAPS_MODIFY = 2 ' Can modify exisiting archives
%PK_CAPS_MULTIPLE = 4 ' Archive can contain multiple files
%PK_CAPS_DELETE = 8 ' Can delete files
%PK_CAPS_OPTIONS = 16 ' Has options dialog
%PK_CAPS_MEMPACK = 32 ' Supports packing in memory
%PK_CAPS_BY_CONTENT = 64 ' Detect archive type by content
%PK_CAPS_SEARCHTEXT = 128 ' Allow searching for text in archives
' created with this plugin
%PK_CAPS_HIDE = 256 ' Show as normal files (hide packer
' icon), open with Ctrl+PgDn, not Enter
' Flags for packing in memory
%MEM_OPTIONS_WANTHEADERS = 1 ' Return archive headers with packed data
' Errors returned by PackToMem
%MEMPACK_OK = 0 ' Function call finished OK, but there is more data
%MEMPACK_DONE = 1 ' Function call finished OK, there is no more data
'== Structures =================================================================
TYPE tHeaderData
ArcName AS ASCIIZ * 260
FileName AS ASCIIZ * 260
Flags AS DWORD
PackSize AS DWORD
UnpSize AS DWORD
HostOS AS DWORD
FileCRC AS DWORD
FileTime AS DWORD
UnpVer AS DWORD
Method AS DWORD
FileAttrib AS DWORD
CmtBuf AS ASCIIZ PTR
CmtBufSize AS DWORD
CmtSize AS DWORD
CmtState AS DWORD
END TYPE
TYPE tOpenArchiveData
ArcName AS ASCIIZ PTR
OpenMode AS DWORD
OpenResult AS DWORD
CmtBuf AS ASCIIZ PTR
CmtBufSize AS DWORD
CmtSize AS DWORD
CmtState AS DWORD
END TYPE
TYPE tFunction
FuncName AS ASCIIZ * 128 'Name of the function
FuncType AS LONG '0=FUNCTION, 1=SUB
FuncStart AS LONG 'Line in source where it starts
FuncEnd AS LONG 'Line in source where it ends
END TYPE
'== Globals ====================================================================
GLOBAL glFuncCount AS LONG 'How many functions did we export?
GLOBAL glFuncCurrent AS LONG 'What function did TC want us to extract?
GLOBAL glLineCount AS LONG 'How many lines are there in the source
GLOBAL gtFunctions() AS tFunction 'Function info storage
GLOBAL gsFileBuffer() AS STRING 'Source code buffer
'== Functions ==================================================================
DECLARE FUNCTION PackTime (Day AS DWORD, Month AS DWORD, Year AS DWORD, _
Hour AS DWORD, Minute AS DWORD, Second AS DWORD) AS DWORD
'-------------------------------------------------------------------------------
' Main DLL entry point called by Windows...
'
FUNCTION LIBMAIN (BYVAL hInstance AS LONG, _
BYVAL fwdReason AS LONG, _
BYVAL lpvReserved AS LONG) AS LONG
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH
'Indicates that the DLL is being loaded by another process (a DLL
'or EXE is loading the DLL). DLLs can use this opportunity to
'initialize any instance or global data, such as arrays.
DIM gtFunctions(1) AS GLOBAL tFunction
DIM gsFileBuffer(1) AS GLOBAL STRING
FUNCTION = 1 'success!
'FUNCTION = 0 'failure! This will prevent the EXE from running.
CASE %DLL_PROCESS_DETACH
'Indicates that the DLL is being unloaded or detached from the
'calling application. DLLs can take this opportunity to clean
'up all resources for all threads attached and known to the DLL.
FUNCTION = 1 'success!
'FUNCTION = 0 'failure!
CASE %DLL_THREAD_ATTACH
'Indicates that the DLL is being loaded by a new thread in the
'calling application. DLLs can use this opportunity to
'initialize any thread local storage (TLS).
FUNCTION = 1 'success!
'FUNCTION = 0 'failure!
CASE %DLL_THREAD_DETACH
'Indicates that the thread is exiting cleanly. If the DLL has
'allocated any thread local storage, it should be released.
FUNCTION = 1 'success!
'FUNCTION = 0 'failure!
END SELECT
END FUNCTION
'== Packer Functions ===========================================================
FUNCTION OpenArchive ALIAS "OpenArchive" (BYREF tArchiveData AS tOpenArchiveData) EXPORT AS DWORD
' Description
' OpenArchive should return a unique handle representing the archive.
' The handle should remain valid until CloseArchive is called.
' If an error occurs, you should return zero, and specify the error by setting OpenResult member of ArchiveData.
' You can use the ArchiveData to query information about the archive being open,
' and store the information in ArchiveData to some location that can be accessed via the handle.
DIM hFile AS DWORD
DIM sTemp AS STRING
DIM lCount AS LONG
DIM sParam1 AS STRING
DIM sParam2 AS STRING
SELECT CASE tArchiveData.OpenMode
CASE %PK_OM_LIST, %PK_OM_EXTRACT
hFile=FREEFILE
ON ERROR RESUME NEXT
OPEN tArchiveData.@ArcName FOR INPUT AS hFile
IF ERRCLEAR=0 THEN
FUNCTION=hFile
ELSE
tArchiveData.OpenResult = %E_EOPEN
FUNCTION=0
EXIT FUNCTION
END IF
glLineCount=0
glFuncCurrent=0
REDIM gsFileBuffer(0) AS GLOBAL STRING
REDIM gtFunctions(0) AS GLOBAL tFunction
DO
IF EOF(hFile) THEN
FUNCTION=%E_END_ARCHIVE
CLOSE hFile
EXIT FUNCTION
END IF
INCR glLineCount
REDIM PRESERVE gsFileBuffer(glLineCount) AS GLOBAL STRING
LINE INPUT #hFile, gsFileBuffer(glLineCount)
sTemp=TRIM$(gsFileBuffer(glLineCount))
lCount=PARSECOUNT(sTemp, " ")
IF lCount>1 THEN
sParam1=UCASE$(PARSE$(sTemp," ",1))
sParam2=PARSE$(sTemp, ANY " (",2)
IF sParam1="FUNCTION" THEN
IF INSTR(sTemp,"=")=0 THEN
INCR glFuncCount
REDIM PRESERVE gtFunctions(glFuncCount) AS GLOBAL tFunction
gtFunctions(glFuncCount).FuncName=sParam2
gtFunctions(glFuncCount).FuncStart=glLineCount
gtFunctions(glFuncCount).FuncType=0
END IF
ELSEIF sParam1="SUB" THEN
INCR glFuncCount
REDIM PRESERVE gtFunctions(glFuncCount) AS GLOBAL tFunction
gtFunctions(glFuncCount).FuncName=sParam2
gtFunctions(glFuncCount).FuncStart=glLineCount
gtFunctions(glFuncCount).FuncType=1
ELSEIF sParam1="END" THEN
sParam2=UCASE$(sParam2)
IF sParam2="FUNCTION" OR sParam2="SUB" THEN
gtFunctions(glFuncCount).FuncEnd=glLineCount
END IF
END IF
END IF
LOOP
CASE ELSE
MSGBOX "Opening: "+tArchiveData.@ArcName+$CRLF+"Open mode: Unknown"+$CRLF,,"WCX Template"
tArchiveData.OpenResult = %E_NOT_SUPPORTED
FUNCTION = 0
END SELECT
END FUNCTION
FUNCTION ReadHeader ALIAS "ReadHeader" (BYVAL hArcData AS DWORD, BYREF HeaderData AS tHeaderData) EXPORT AS DWORD
INCR glFuncCurrent
IF glFuncCurrent<(glFuncCount+1) THEN
SELECT CASE gtFunctions(glFuncCurrent).FuncType
CASE 0 'Function
HeaderData.FileName="FUNCTION\"+gtFunctions(glFuncCurrent).FuncName
CASE 1 'Sub
HeaderData.FileName="SUB\"+gtFunctions(glFuncCurrent).FuncName
END SELECT
HeaderData.FileTime = PackTime(1,2,2003,12,14,46) '01-02-2003 12:14:46 (arbitrary date)
'Report number of lines as size
HeaderData.UnpSize = gtFunctions(glFuncCurrent).FuncEnd-gtFunctions(glFuncCurrent).FuncStart+1
HeaderData.PackSize = HeaderData.UnpSize
FUNCTION=0
ELSE
FUNCTION=%E_END_ARCHIVE
END IF
END FUNCTION
FUNCTION ProcessFile ALIAS "ProcessFile" (BYVAL hArcData AS DWORD, BYVAL Operation AS LONG, _
BYREF DestPath AS ASCIIZ PTR, BYREF DestName AS ASCIIZ PTR) EXPORT AS DWORD
DIM sDestination AS STRING
DIM hFile AS LONG
DIM lCount AS LONG
IF LEN(@DestPath)=0 THEN
sDestination = @DestName
ELSE
sDestination = @DestPath + "\" + @DestName
END IF
IF Operation=%PK_EXTRACT THEN
hFile=FREEFILE
OPEN sDestination FOR OUTPUT AS #hFile
FOR lCount=gtFunctions(glFuncCurrent).FuncStart TO gtFunctions(glFuncCurrent).FuncEnd
PRINT #hFile, gsFileBuffer(lCount)
NEXT
CLOSE #hFile
END IF
FUNCTION = 0
END FUNCTION
FUNCTION CloseArchive ALIAS "CloseArchive" (BYVAL hArcData AS DWORD) EXPORT AS DWORD
'Description
'CloseArchive should return zero on success, or one of the error values otherwise.
'It should free all the resources associated with the open archive.
'The parameter hArcData refers to the value returned by a programmer within a previous call to OpenArchive.
FUNCTION = 0
END FUNCTION
SUB SetChangeVolProc ALIAS "SetChangeVolProc" (BYVAL hArcData AS DWORD, BYVAL pChangeVolProc1 AS DWORD) EXPORT
'Description
'pChangeVolProc1 contains a pointer to a function that you may want to call when notifying user
'to change volume (e.g. insterting another diskette). You need to store the value at some place
'if you want to use it; you can use hArcData that you have
'returned by OpenArchive to identify that place.
'==== Ask to swap disk for multi-volume archive ================================
' Save the pointer somewhere and call like
' CALL DWORD pChangeVolProc1 USING (ArcName AS ASCIIZ, Mode AS DWORD) TO lResult
'
END SUB
SUB SetProcessDataProc ALIAS "SetProcessDataProc" (BYVAL hArcData AS DWORD, BYVAL pProcessDataProc AS DWORD) EXPORT
' Sae the pointer somewhere and call like
' CALL DWORD pProcessDataProc (FileName AS ASCIIZ, FileSize AS DWORD) TO lResult
END SUB
'== General support functions ==================================================
FUNCTION PackTime (Day AS DWORD, Month AS DWORD, Year AS DWORD, _
Hour AS DWORD, Minute AS DWORD, Second AS DWORD) AS DWORD
'FileTime contains the date and the time of the file’s last update. Use the following algorithm to set the value:
'FileTime = (year - 1980) << 25 | month << 21 | day << 16 | hour << 11 | minute << 5 | second/2;
'Make sure that:
'year is in the four digit format between 1980 and 2100
'month is a number between 1 and 12
'hour is in the 24 hour format
DIM TempTime AS DWORD
DIM lYear AS DWORD
DIM lMonth AS DWORD
DIM lDay AS DWORD
DIM lHour AS DWORD
DIM lMinute AS DWORD
DIM lSecond AS DWORD
lYear = Year - 1980
lMonth = Month
lDay = Day
lHour = Hour
lMinute = Minute
lSecond = Second
SHIFT LEFT lYear, 25
SHIFT LEFT lMonth, 21
SHIFT LEFT lDay, 16
SHIFT LEFT lHour, 11
SHIFT LEFT lMinute, 5
lSecond = lSecond \ 2
FUNCTION = lYear OR lMonth OR lDay OR lHour OR lMinute OR lSecond
END FUNCTION
[This message has been edited by Jeroen Stephan van Rijn (edited March 05, 2003).]
