Announcement

Collapse
No announcement yet.

porting a VB6 class

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • porting a VB6 class

    I have been trying to port the VB6 class at http://vb.mvps.org/samples/project.asp?id=DirDrill to PB9. The places where it will not compile are now lines 186 and 188. I will have trouble at line 191, too. (Those are my line numbers, not the original.) Also note that I commented out two FUNCTIONs using #IF 0 / #ENDIF.

    How should I fix the 3 lines in question? Feel free to make other changes.

    Code:
    #COMPILE DLL
    #DIM ALL
    
    
    %USEMACROS = 1
    #INCLUDE "Win32API.inc"
    
    GLOBAL ghInstance AS DWORD
    
    
    
    CLASS CDirDrill
        INSTANCE m_Cancel AS LONG
        INSTANCE m_Pattern AS STRING
        INSTANCE m_Recurse AS LONG
        INSTANCE m_Folder AS STRING
        INSTANCE m_TotalFiles AS LONG
        INSTANCE m_TotalDirs AS LONG
        INSTANCE m_AttrMask AS LONG
        INTERFACE DirDrill AS EVENT
            INHERIT IUNKNOWN
    
            PROPERTY GET AttributeMask() AS LONG
                PROPERTY = m_AttrMask
            END PROPERTY
    
            PROPERTY SET AttributeMask(BYVAL NewMask AS LONG)
                ' Needed in order to find hidden/system files, or
                ' simply to narrow the search to specific attribs.
                m_AttrMask = NewMask
            END PROPERTY
    
            PROPERTY GET Folder() AS STRING
                PROPERTY = m_Folder
            END PROPERTY
    
            PROPERTY SET Folder(BYVAL NewValue AS STRING)
                IF ISFILE(NewValue) THEN
                    m_Folder = NewValue
                END IF
            END PROPERTY
    
            PROPERTY GET Pattern() AS STRING
                PROPERTY = m_Pattern
            END PROPERTY
    
            PROPERTY SET Pattern(BYVAL NewValue AS STRING)
                ' Accept delimited list of filespecs, replacing all
                ' commas with semi-colons, and eliminating spaces.
                REPLACE "," WITH ";" IN NewValue
                m_Pattern = REMOVE$(NewValue,$SPC)
            END PROPERTY
    
            PROPERTY GET Recursive() AS LONG
                PROPERTY = m_Recurse
            END PROPERTY
    
            PROPERTY SET Recursive(BYVAL NewRecursive AS LONG)
                ' Flag indicates whether to recurse entire dirtree.
                m_Recurse = NewRecursive
            END PROPERTY
    
            METHOD BeginSearch(OPTIONAL BYVAL StartFolder AS STRING)
                ' Assign new path, if asked to.
                IF LEN(StartFolder) THEN
                    Me.Folder = StartFolder
                END IF
                ' Reset counters, and start recursion.
                m_Cancel = %FALSE
                m_TotalFiles = 0
                m_TotalDirs = 1  'always have a starting folder!
                CALL RecurseFolders(m_Folder)
                RAISEEVENT Done(m_TotalFiles, m_TotalDirs)
                ' Clear any outstanding locks held by Dir$()
                CALL DIR$("nul")
            END METHOD
    
            METHOD FileText(BYVAL filespec AS STRING) AS STRING
                DIM hFile AS LONG
                ON ERROR RESUME NEXT
                ' Return entire file contents as string, ignoring errors.
                hFile = FREEFILE
                OPEN filespec FOR INPUT AS #hFile
                METHOD = INPUT(LOF(hFile), #hFile)
                CLOSE #hFile
            END METHOD
    
            METHOD ExtractName(BYVAL SpecIn AS STRING, OPTIONAL BaseOnly AS LONG) AS STRING
                DIM nPos AS LONG
                DIM SpecOut AS STRING
                IF ISMISSING(BaseOnly) THEN BaseOnly=%FALSE
                ' Make sure we don't have a directory.
                IF NOT ISFILE(SpecIn) THEN
                    ' Find last backslash, and keep what follows.
                    nPos = INSTR(-1,SpecIn, "\")
                    IF nPos < LEN(SpecIn) THEN
                        SpecOut = MID$(SpecIn, nPos + 1)
                    ELSE
                        SpecOut = SpecIn
                    END IF
    
                    ' If user requested, remove the extension.
                    ' Useful for appending a different extension.
                    IF BaseOnly THEN
                        nPos = INSTR(-1,SpecOut, ".")
                        IF nPos < LEN(SpecOut) THEN
                            SpecOut = LEFT$(SpecOut, nPos - 1)
                        END IF
                    END IF
                END IF
    
                ' Return SpecOut
                METHOD = SpecOut
            END METHOD
    
            METHOD ExtractPath(BYVAL SpecIn AS STRING) AS STRING
                DIM nPos AS LONG
                DIM SpecOut AS STRING
    
                ' Make sure we don't already have a directory.
                IF ISFILE(SpecIn) THEN
                    SpecOut = Backslashed(SpecIn)
                ELSE
                    ' Find last backslash, and keep what follows.
                    nPos = INSTR(-1,SpecIn, "\")
                    IF nPos THEN
                        SpecOut = LEFT$(SpecIn, nPos)
                    END IF
                END IF
    
                ' Return SpecOut
                METHOD = SpecOut
            END METHOD
    
        END INTERFACE
    END CLASS
    
    FUNCTION Backslashed(BYVAL SpecIn AS STRING) AS STRING
       ' Make sure path ends with backslash.
       IF ISFILE(SpecIn) THEN
          IF RIGHT(SpecIn, 1) <> "\" THEN
             SpecIn = SpecIn & "\"
          END IF
       END IF
       Backslashed = SpecIn
    END FUNCTION
    
    #IF 0
    FUNCTION GETATTR(BYVAL PathName AS STRING) AS LONG
       'Const INVALID_FILE_ATTRIBUTES As Long = -1&
       ' Use API to retrieve file attributes, because VBA.GetAttr
       ' chokes on files that have attributes not used by the time
       ' VB5/6 were released.  :-(
       GETATTR = GetFileAttributes(PathName)
    END FUNCTION
    #ENDIF
    
    #IF 0
    FUNCTION IsDirectory(BYVAL PathName AS STRING) AS Boolean
       DIM Attr AS LONG
       ' Make sure we have a valid attribute to check.
       Attr = GETATTR(PathName)
       IF Attr <> INVALID_FILE_ATTRIBUTES THEN
          ' Check for presence of Directory attribute.
          IF (Attr AND vbDirectory) = vbDirectory THEN
             IsDirectory = True
          END IF
       END IF
    END FUNCTION
    #ENDIF
    
    %nIncrement = 100
    SUB RecurseFolders(BYVAL StartPath AS STRING)
       DIM Dirs() AS STRING, Files() AS STRING
       'Dim Patterns() As String  '<= Use this with VB6 Split
       DIM Patterns AS VARIANT
       DIM nDirs AS LONG, nFiles AS LONG
       DIM FileName AS STRING
       DIM This AS STRING
       DIM i AS LONG
    
       ' Make sure there's a trailing backslash.
       StartPath = Backslashed(StartPath)
    
       ' Alert user that a new folder is being processed.
       RAISEEVENT NewFolder(StartPath, m_Cancel)
    
       IF ISFALSE m_Cancel THEN
          ' Build array of all directories under "here."
          REDIM Dirs(0 TO nIncrement - 1) AS STRING
          FileName = Dir(StartPath & "*.*", vbDirectory)
          DO WHILE LEN(FileName)
             This = StartPath & FileName
             IF IsDirectory(This) THEN
                ' Ignore dotted directory names
                IF LEFT$(FileName, 1) <> "." THEN
                   IF nDirs > UBOUND(Dirs) THEN
                      REDIM PRESERVE Dirs(0 TO UBOUND(Dirs) + nIncrement) AS STRING
                   END IF
                   Dirs(nDirs) = This
                   nDirs = nDirs + 1
                END IF
             END IF
             ' Continue...
             FileName = Dir()
          LOOP
    
          ' Build array of wildcard filespec patterns.
          Patterns = Split(m_Pattern, ";")
    
          ' Begin scanning for all files that match each spec.
          REDIM Files(0 TO nIncrement - 1) AS STRING
          FOR i = LBOUND(Patterns) TO UBOUND(Patterns)
             FileName = Dir(StartPath & Patterns(i), m_AttrMask)
             DO WHILE LEN(FileName)
                This = StartPath & FileName
                IF IsDirectory(This) = False THEN
                   'If (GetAttr(This) And m_AttrMask) Then
                      IF nFiles > UBOUND(Files) THEN
                         REDIM PRESERVE Files(0 TO UBOUND(Files) + nIncrement) AS STRING
                      END IF
                      Files(nFiles) = This
                      nFiles = nFiles + 1
                   'End If
                END IF
                ' Continue...
                FileName = Dir()
             LOOP
          NEXT i
       END IF
    
       ' Increment counters
       m_TotalFiles = m_TotalFiles + nFiles
       m_TotalDirs = m_TotalDirs + nDirs
    
       ' Process each file in this directory.
       FOR i = 0 TO nFiles - 1
          RAISEEVENT NewFile(Files(i), m_Cancel)
          IF m_Cancel THEN EXIT FOR
       NEXT i
    
       ' Process each directory found.
       IF (m_Recurse = True) THEN
          FOR i = 0 TO nDirs - 1
             RecurseFolders Dirs(i)
             ' Bail if user cancelled in last procedure.
             IF m_Cancel THEN EXIT FOR
          NEXT i
       END IF
    END SUB
    
    
    '-------------------------------------------------------------------------------
    ' 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.
    
            ghInstance = hInstance
    
            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
    Erich Schulman (KT4VOL/KTN4CA)
    Go Big Orange

  • #2
    It looks like you should be encapsulating the Subs and Functions as CLASS METHODs in a class. For example, on trying to compile the compiler flags the RAISEEVENT in the SUB RecurseFolders

    The help file says:
    The RAISEEVENT statement is used to call event handler code from an Event Source. RAISEEVENT may only appear within a class which declares the Event Source interface.
    Can you post the calling code too? IOW, where are you specifying, in a class the EVENT SOURCE?

    See the EVENTS statement page in the help file for sample code for events.
    Last edited by Richard Angell; 17 Sep 2008, 08:51 AM. Reason: Expanded slightly ... Added Emphasis
    Rick Angell

    Comment


    • #3
      Originally posted by Richard Angell View Post
      It looks like you should be encapsulating the Subs and Functions as CLASS METHODs in a class. For example, on trying to compile the compiler flags the RAISEEVENT in the SUB RecurseFolders
      Should I make it a second class that inherits the class I already started?

      The help file says:
      Can you post the calling code too? IOW, where are you specifying, in a class the EVENT SOURCE?
      There is none yet -- not from me, anyway. Go to the URL I referenced and you'll find a sample.

      I would really like something comparable to REXX's SysFileTree (see IBM's help for info on it). While Python does have os.walk, I have always preferred the REXX way. Once I can get this class ported correctly, I can play around until I get it more to my liking.
      Erich Schulman (KT4VOL/KTN4CA)
      Go Big Orange

      Comment


      • #4
        You will want to create a seperate event class, such as
        Code:
        CLASS ECDirDrill AS EVENT
          INTERFACE IEDirDrill AS EVENT
        
            INHERIT IDISPATCH
        
            METHOD NewFile(BYVAL filespec AS STRING, CANCEL AS LONG)
               ' Show that we found one...
               #DEBUG PRINT SPACE$(5) & dd.ExtractName(filespec)
               ' Do any other processing here...
            END METHOD
        
            METHOD NewFolder(BYVAL FolderSpec AS STRING, CANCEL AS LONG)
              ' Output new folder found.
              #DEBUG PRINT FolderSpec
              ' Take a breath, bail if Escape was pressed.
              DIALOG DOEVENTS
            END METHOD
          
            METHOD Done(BYVAL TotalFiles AS LONG, BYVAL TotalFolders AS LONG)
              LOCAL s AS STRING
              LOCAL i AS LONG
            
              #DEBUG PRINT "Found " & TotalFiles & " files in " & TotalFolders & " folders."
              CLIPBOARD RESET TO i
            
              CONTROL GET TEXT hdlg, %ID_TEXT TO s
              CLIPBOARD SET TEXT s TO i
           END METHOD
        
          END INTERFACE
        END CLASS
        and then in your CDirDrill class add the line
        Code:
        EVENT SOURCE IEDirDrill
        You will also want to make the subs and functions defined in CDirDrill.cls CLASS METHODS of the CDirDrill class. This is so the ME and RAISEEVENT code functions correctly.
        Sincerely,

        Steve Rossell
        PowerBASIC Staff

        Comment


        • #5
          I have made some progress, as the code below shows. I am slowly working in more PB features at the same time.

          I am not quite sure what to do with the %ID_TEXT which presently stops the compiler. Should I define this at the top to something, or should I replace this with a variable whose value is supplied by the program using the class?

          Code:
          #COMPILE DLL
          #DIM ALL
          
          
          %USEMACROS = 1
          #INCLUDE "Win32API.inc"
          
          GLOBAL ghInstance AS DWORD
          
          %nIncrement = 100
          
          CLASS CDirDrill
              INSTANCE m_Cancel AS LONG
              INSTANCE m_Pattern AS STRING
              INSTANCE m_Recurse AS LONG
              INSTANCE m_Folder AS STRING
              INSTANCE m_TotalFiles AS LONG
              INSTANCE m_TotalDirs AS LONG
              INSTANCE m_AttrMask AS LONG
              INSTANCE Patterns() AS STRING
              INTERFACE DirDrill AS EVENT
                  INHERIT IUNKNOWN
          
                  PROPERTY GET AttributeMask() AS LONG
                      PROPERTY = m_AttrMask
                  END PROPERTY
          
                  PROPERTY SET AttributeMask(BYVAL NewMask AS LONG)
                      ' Needed in order to find hidden/system files, or
                      ' simply to narrow the search to specific attribs.
                      m_AttrMask = NewMask
                  END PROPERTY
          
                  PROPERTY GET Folder() AS STRING
                      PROPERTY = m_Folder
                  END PROPERTY
          
                  PROPERTY SET Folder(BYVAL NewValue AS STRING)
                      IF ISFILE(NewValue) THEN
                          m_Folder = NewValue
                      END IF
                  END PROPERTY
          
                  PROPERTY GET Pattern() AS STRING
                      PROPERTY = m_Pattern
                  END PROPERTY
          
                  PROPERTY SET Pattern(BYVAL NewValue AS STRING)
                      ' Accept delimited list of filespecs, replacing all
                      ' commas with semi-colons, and eliminating spaces.
                      REPLACE "," WITH ";" IN NewValue
                      m_Pattern = REMOVE$(NewValue,$SPC)
                  END PROPERTY
          
                  PROPERTY GET Recursive() AS LONG
                      PROPERTY = m_Recurse
                  END PROPERTY
          
                  PROPERTY SET Recursive(BYVAL NewRecursive AS LONG)
                      ' Flag indicates whether to recurse entire dirtree.
                      m_Recurse = NewRecursive
                  END PROPERTY
          
                  METHOD BeginSearch(OPTIONAL BYVAL StartFolder AS STRING)
                      ' Assign new path, if asked to.
                      IF LEN(StartFolder) THEN
                          Me.Folder = StartFolder
                      END IF
                      ' Reset counters, and start recursion.
                      m_Cancel = %FALSE
                      m_TotalFiles = 0
                      m_TotalDirs = 1  'always have a starting folder!
                      ME.RecurseFolders(m_Folder)
                      RAISEEVENT Done(m_TotalFiles, m_TotalDirs)
                      ' Clear any outstanding locks held by Dir$()
                      CALL DIR$("nul")
                  END METHOD
          
                  METHOD FileText(BYVAL filespec AS STRING) AS STRING
                      LOCAL AllText AS STRING
                      DIM hFile AS LONG
                      ON ERROR RESUME NEXT
                      ' Return entire file contents as string, ignoring errors.
                      hFile = FREEFILE
                      OPEN filespec FOR BINARY AS #hFile
                          GET$ #hFile, LOF(#1), AllText
                      CLOSE #hFile
                      METHOD = AllText
                  END METHOD
          
                  METHOD ExtractName(BYVAL SpecIn AS STRING, OPTIONAL BaseOnly AS LONG) AS STRING
                      DIM nPos AS LONG
                      DIM SpecOut AS STRING
                      IF ISMISSING(BaseOnly) THEN BaseOnly = %FALSE
                      ' Make sure we don't have a directory.
                      IF NOT ISFILE(SpecIn) THEN
                          ' Find last backslash, and keep what follows.
                          nPos = INSTR(-1,SpecIn, "\")
                          IF nPos < LEN(SpecIn) THEN
                              SpecOut = MID$(SpecIn, nPos + 1)
                          ELSE
                              SpecOut = SpecIn
                          END IF
          
                          ' If user requested, remove the extension.
                          ' Useful for appending a different extension.
                          IF BaseOnly THEN
                              nPos = INSTR(-1,SpecOut, ".")
                              IF nPos < LEN(SpecOut) THEN
                                  SpecOut = LEFT$(SpecOut, nPos - 1)
                              END IF
                          END IF
                      END IF
          
                      ' Return SpecOut
                      METHOD = SpecOut
                  END METHOD
          
                  METHOD ExtractPath(BYVAL SpecIn AS STRING) AS STRING
                  'We can probably reduce this to a PATHNAME$, hurray for PB9
                      DIM nPos AS LONG
                      DIM SpecOut AS STRING
          
                      ' Make sure we don't already have a directory.
                      IF ISFILE(SpecIn) THEN
                          SpecOut = Me.Backslashed(SpecIn)
                      ELSE
                          ' Find last backslash, and keep what follows.
                          nPos = INSTR(-1,SpecIn, "\")
                          IF nPos THEN
                              SpecOut = LEFT$(SpecIn, nPos)
                          END IF
                      END IF
          
                      ' Return SpecOut
                      METHOD = SpecOut
                  END METHOD
          
                  METHOD Backslashed(BYVAL SpecIn AS STRING) AS STRING
                      ' Make sure path ends with backslash.
                      IF ISFILE(SpecIn) THEN
                          IF RIGHT$(SpecIn, 1) <> "\" THEN
                              SpecIn = SpecIn & "\"
                          END IF
                      END IF
                  METHOD = SpecIn
              END METHOD
          
              METHOD RecurseFolders(BYVAL StartPath AS STRING)
                  DIM Dirs() AS STRING, Files() AS STRING
                  DIM Patterns AS STRING
                  DIM nDirs AS LONG, nFiles AS LONG
                  DIM FileName AS STRING
                  DIM This AS STRING
                  DIM i AS LONG
          
                  ' Make sure there's a trailing backslash.
                  StartPath = Me.Backslashed(StartPath)
          
                  ' Alert user that a new folder is being processed.
                  RAISEEVENT NewFolder(StartPath, m_Cancel)
          
                  IF ISFALSE m_Cancel THEN
                      ' Build array of all directories under "here."
                      REDIM Dirs(0 TO %nIncrement - 1) AS STRING
                      FileName = DIR$(StartPath & "*.*", %SUBDIR)
                      DO WHILE LEN(FileName)
                          This = StartPath & FileName
                          IF ISFILE(This) THEN
                              ' Ignore dotted directory names
                              IF LEFT$(FileName, 1) <> "." THEN
                                  IF nDirs > UBOUND(Dirs) THEN
                                      REDIM PRESERVE Dirs(0 TO UBOUND(Dirs) + %nIncrement) AS STRING
                                  END IF
                              Dirs(nDirs) = This
                              nDirs = nDirs + 1
                              END IF
                          END IF
                          ' Continue...
                          FileName = DIR$()
                      LOOP
          
                      ' Build array of wildcard filespec patterns.
                      PARSE m_Pattern,Patterns,";"
          
                      ' Begin scanning for all files that match each spec.
                      REDIM Files(0 TO %nIncrement - 1) AS STRING
                      FOR i = LBOUND(Patterns) TO UBOUND(Patterns)
                          FileName = DIR$(StartPath & Patterns(i), m_AttrMask)
                          DO WHILE LEN(FileName)
                              This = StartPath & FileName
                              IF NOT ISFILE(This) THEN 'Line below is commented in the original
                                  'If (GetAttr(This) And m_AttrMask) Then
                                  IF nFiles > UBOUND(Files) THEN
                                      REDIM PRESERVE Files(0 TO UBOUND(Files) + %nIncrement) AS STRING
                                  END IF
                                  Files(nFiles) = This
                                  nFiles = nFiles + 1
                                  'Line below commented in the original
                                  'End If
                              END IF
                              ' Continue...
                              FileName = DIR$()
                          LOOP
                      NEXT i
                  END IF
          
                  ' Increment counters
                  m_TotalFiles = m_TotalFiles + nFiles
                  m_TotalDirs = m_TotalDirs + nDirs
          
                  ' Process each file in this directory.
                  FOR i = 0 TO nFiles - 1
                      RAISEEVENT NewFile(Files(i), m_Cancel)
                      IF m_Cancel THEN EXIT FOR
                  NEXT i
          
                  ' Process each directory found.
                  IF (m_Recurse = %TRUE) THEN
                      FOR i = 0 TO nDirs - 1
                          Me.RecurseFolders Dirs(i)
                          ' Bail if user cancelled in last procedure.
                          IF m_Cancel THEN EXIT FOR
                      NEXT i
                  END IF
              END METHOD
          
              END INTERFACE
              
              EVENT SOURCE IEDirDrill
          END CLASS
          
          CLASS ECDirDrill AS EVENT
              INTERFACE IEDirDrill AS EVENT
              INHERIT IDISPATCH
          
              METHOD NewFile(BYVAL filespec AS STRING, CANCEL AS LONG)
                 ' Show that we found one...
                 #DEBUG PRINT SPACE$(5) & dd.ExtractName(filespec)
                 ' Do any other processing here...
              END METHOD
          
              METHOD NewFolder(BYVAL FolderSpec AS STRING, CANCEL AS LONG)
                ' Output new folder found.
                #DEBUG PRINT FolderSpec
                ' Take a breath, bail if Escape was pressed.
                DIALOG DOEVENTS
              END METHOD
          
              METHOD Done(BYVAL TotalFiles AS LONG, BYVAL TotalFolders AS LONG)
                LOCAL s AS STRING
                LOCAL i AS LONG
          
                #DEBUG PRINT "Found " & TotalFiles & " files in " & TotalFolders & " folders."
                CLIPBOARD RESET TO i
          
                CONTROL GET TEXT hdlg, %ID_TEXT TO s
                CLIPBOARD SET TEXT s TO i
             END METHOD
          
            END INTERFACE
          END CLASS
          
          
          '-------------------------------------------------------------------------------
          ' 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.
          
                  ghInstance = hInstance
          
                  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
          Erich Schulman (KT4VOL/KTN4CA)
          Go Big Orange

          Comment


          • #6
            You need it not to be an equate, but an INSTANCE variable that gets assigned at creation. Otherwise maybe just replace all instances in the code with the literal value.
            Rick Angell

            Comment


            • #7
              I have some code for the DLL that compiles now.

              Code:
              #COMPILE DLL
              #DIM ALL
              
              
              %USEMACROS = 1
              #INCLUDE "Win32API.inc"
              
              GLOBAL ghInstance AS DWORD
              
              %nIncrement = 100
              
              CLASS ECDirDrill AS EVENT
                  INSTANCE dlgID_TEXT AS DWORD
                  INSTANCE hdlg AS DWORD
                  INTERFACE IEDirDrill AS EVENT
                  INHERIT IDISPATCH
              
                  METHOD NewFile(BYVAL filespec AS STRING, CANCEL AS LONG)
                     ' Show that we found one...
                     #DEBUG PRINT SPACE$(5) & dd.ExtractName(filespec)
                     ' Do any other processing here...
                  END METHOD
              
                  METHOD NewFolder(BYVAL FolderSpec AS STRING, CANCEL AS LONG)
                    ' Output new folder found.
                    #DEBUG PRINT FolderSpec
                    ' Take a breath, bail if Escape was pressed.
                    DIALOG DOEVENTS
                  END METHOD
              
                  METHOD Done(BYVAL TotalFiles AS LONG, BYVAL TotalFolders AS LONG)
                    LOCAL s AS STRING
                    LOCAL i AS LONG
              
                    #DEBUG PRINT "Found " & TotalFiles & " files in " & TotalFolders & " folders."
                    CLIPBOARD RESET TO i
              
                    CONTROL GET TEXT hdlg, dlgID_TEXT TO s
                    CLIPBOARD SET TEXT s TO i
                 END METHOD
              
                END INTERFACE
              END CLASS
              
              CLASS CDirDrill
                  INSTANCE m_Cancel AS LONG
                  INSTANCE m_Pattern AS STRING
                  INSTANCE m_Recurse AS LONG
                  INSTANCE m_Folder AS STRING
                  INSTANCE m_TotalFiles AS LONG
                  INSTANCE m_TotalDirs AS LONG
                  INSTANCE m_AttrMask AS LONG
                  INSTANCE Patterns() AS STRING
                  INTERFACE DirDrill AS EVENT
              
                      INHERIT IUNKNOWN
              
                      PROPERTY GET AttributeMask() AS LONG
                          PROPERTY = m_AttrMask
                      END PROPERTY
              
                      PROPERTY SET AttributeMask(BYVAL NewMask AS LONG)
                          ' Needed in order to find hidden/system files, or
                          ' simply to narrow the search to specific attribs.
                          m_AttrMask = NewMask
                      END PROPERTY
              
                      PROPERTY GET Folder() AS STRING
                          PROPERTY = m_Folder
                      END PROPERTY
              
                      PROPERTY SET Folder(BYVAL NewValue AS STRING)
                          IF ME.IsDirectory(NewValue) THEN m_Folder = NewValue
                      END PROPERTY
              
                      PROPERTY GET Pattern() AS STRING
                          PROPERTY = m_Pattern
                      END PROPERTY
              
                      PROPERTY SET Pattern(BYVAL NewValue AS STRING)
                          ' Accept delimited list of filespecs, replacing all
                          ' commas with semi-colons, and eliminating spaces.
                          REPLACE "," WITH ";" IN NewValue
                          m_Pattern = REMOVE$(NewValue,$SPC)
                      END PROPERTY
              
                      PROPERTY GET Recursive() AS LONG
                          PROPERTY = m_Recurse
                      END PROPERTY
              
                      PROPERTY SET Recursive(BYVAL NewRecursive AS LONG)
                          ' Flag indicates whether to recurse entire dirtree.
                          m_Recurse = NewRecursive
                      END PROPERTY
              
                      METHOD BeginSearch(OPTIONAL BYVAL StartFolder AS STRING)
                          ' Assign new path, if asked to.
                          IF LEN(StartFolder) THEN 'cannot make this a single-line IF
                              Me.Folder = StartFolder
                          END IF
                          ' Reset counters, and start recursion.
                          m_Cancel = %FALSE
                          m_TotalFiles = 0
                          m_TotalDirs =  1  'always have a starting folder!
                          ME.RecurseFolders(m_Folder)
                          RAISEEVENT IEDirDrill.Done(m_TotalFiles, m_TotalDirs)
                          ' Clear any outstanding locks held by Dir$()
                          DIR$ CLOSE
                      END METHOD
              
                      METHOD FileText(BYVAL filespec AS STRING) AS STRING
                          LOCAL AllText AS STRING
                          DIM hFile AS LONG
                          ON ERROR RESUME NEXT
                          ' Return entire file contents as string, ignoring errors.
                          hFile = FREEFILE
                          OPEN filespec FOR BINARY AS #hFile
                              GET$ #hFile, LOF(#1), AllText
                          CLOSE #hFile
                          METHOD = AllText
                      END METHOD
              
                      METHOD ExtractName(BYVAL SpecIn AS STRING, OPTIONAL BaseOnly AS LONG) AS STRING
                          IF Me.IsDirectory(SpecIn) THEN
                              METHOD = $NUL 'original left the return value undefined
                              EXIT METHOD
                          END IF
                          IF ISMISSING(BaseOnly) THEN
                              METHOD = PATHNAME$(NAMEX,SpecIn)
                              EXIT METHOD
                          END IF
                          IF BaseOnly THEN
                              METHOD = PATHNAME$(NAME,SpecIn)
                          ELSE
                              METHOD = PATHNAME$(NAMEX,SpecIn)
                          END IF
                      END METHOD
              
                      METHOD ExtractPath(BYVAL SpecIn AS STRING) AS STRING
                          METHOD = PATHNAME$(PATH,SpecIn)
                      END METHOD
              
                      METHOD Backslashed(BYVAL SpecIn AS STRING) AS STRING
                          ' Make sure path ends with backslash.
                          IF ISFILE(SpecIn) THEN
                              IF RIGHT$(SpecIn, 1) <> "\" THEN SpecIn = SpecIn + "\"
                          END IF
                      METHOD = SpecIn
                  END METHOD
              
                  METHOD RecurseFolders(BYVAL StartPath AS STRING)
                      LOCAL Dirs(),Files() AS STRING
                      LOCAL Patterns() AS STRING
                      LOCAL nDirs,nFiles AS LONG
                      LOCAL FileName AS STRING
                      LOCAL This AS STRING
                      LOCAL i AS LONG
              
                      ' Make sure there's a trailing backslash.
                      StartPath = Me.Backslashed(StartPath)
              
                      ' Alert user that a new folder is being processed.
                      RAISEEVENT IEDirDrill.NewFolder(StartPath, m_Cancel)
              
                      IF ISFALSE m_Cancel THEN
                          ' Build array of all directories under "here."
                          REDIM Dirs(0 TO %nIncrement - 1) AS STRING
                          FileName = DIR$(StartPath & "*.*", %SUBDIR)
                          DO WHILE LEN(FileName)
                              This = StartPath & FileName
                              IF ISFILE(This) THEN
                                  ' Ignore dotted directory names
                                  IF LEFT$(FileName, 1) <> "." THEN
                                      IF nDirs > UBOUND(Dirs) THEN
                                          REDIM PRESERVE Dirs(0 TO UBOUND(Dirs) + %nIncrement) AS STRING
                                      END IF
                                  Dirs(nDirs) = This
                                  nDirs = nDirs + 1
                                  END IF
                              END IF
                              ' Continue...
                              FileName = DIR$()
                          LOOP
              
                          ' Build array of wildcard filespec patterns.
                          REDIM Patterns(0 TO PARSECOUNT(m_Pattern,";"))
                          PARSE m_Pattern,Patterns(),";"
              
                          ' Begin scanning for all files that match each spec.
                          REDIM Files(0 TO %nIncrement - 1) AS STRING
                          FOR i = LBOUND(Patterns) TO UBOUND(Patterns)
                              FileName = DIR$(StartPath & Patterns(i), m_AttrMask)
                              DO WHILE LEN(FileName)
                                  This = StartPath & FileName
                                  IF NOT ISFILE(This) THEN 'Line below is commented in the original
                                      'If (GetAttr(This) And m_AttrMask) Then
                                      IF nFiles > UBOUND(Files) THEN
                                          REDIM PRESERVE Files(0 TO UBOUND(Files) + %nIncrement) AS STRING
                                      END IF
                                      Files(nFiles) = This
                                      nFiles = nFiles + 1
                                      'Line below commented in the original
                                      'End If
                                  END IF
                                  ' Continue...
                                  FileName = DIR$()
                              LOOP
                          NEXT i
                      END IF
              
                      ' Increment counters
                      m_TotalFiles = m_TotalFiles + nFiles
                      m_TotalDirs = m_TotalDirs + nDirs
              
                      ' Process each file in this directory.
                      FOR i = 0 TO nFiles - 1
                          RAISEEVENT IEDirDrill.NewFile(Files(i), m_Cancel)
                          IF m_Cancel THEN EXIT FOR
                      NEXT i
              
                      ' Process each directory found.
                      IF (m_Recurse = %TRUE) THEN
                          FOR i = 0 TO nDirs - 1
                              Me.RecurseFolders(Dirs(i))
                              ' Bail if user cancelled in last procedure.
                              IF m_Cancel THEN EXIT FOR
                          NEXT i
                      END IF
                  END METHOD
              
                  METHOD IsDirectory(BYVAL PathName AS STRING) AS LONG
                      LOCAL Attr AS LONG
                      ' Make sure we have a valid attribute to check.
                      IF NOT ISFILE(PathName) THEN
                          METHOD = %FALSE
                          EXIT METHOD
                      END IF
                      Attr = GETATTR(PathName)
                      ' Check for presence of Directory attribute.
                      IF (Attr AND %SUBDIR) = %SUBDIR THEN
                          METHOD = %TRUE
                      ELSE
                          METHOD = %FALSE
                      END IF
                  END METHOD
              
                  END INTERFACE
              
                  EVENT SOURCE IEDirDrill
              
              END CLASS
              
              
              
              '-------------------------------------------------------------------------------
              ' 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.
              
                      ghInstance = hInstance
              
                      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
              Now it is time to start trying it out and looking for any problems.

              This compiles but is hardly useful as it stands.
              Code:
              #COMPILE EXE
              #DIM ALL
              
              FUNCTION PBMAIN () AS LONG
              LOCAL dd AS IDISPATCH
                  LET dd = NEWCOM CLSID "CDirDrill" LIB "cdrill.dll"
                  OBJECT CALL dd.BeginSearch
              END FUNCTION
              Sample code to use the class appears on the page I referenced when first starting this topic as well as in fsearch.frm which can be downloaded from there. Where do I go next to start using this?
              Erich Schulman (KT4VOL/KTN4CA)
              Go Big Orange

              Comment

              Working...
              X