Thursday, 23 January 2014

Scan / Search directory and sub directories using Mapbasic and Windows API

In this post I will demonstrate how to scan a directory and sub-directories and return a list of files.

I have coded the function GetFileList that you can copy into your project (make sure you also copy the required delarations, type, defines ect...)

Function GetFileList(ByVal strFilePath as String,
                     ByVal strFileFilter as String,
                     strFileList() as String
                     ) as Logical

All you have to do is call the funtion and parse a starting directory strFilePath (Note: make sure you have a trailing slash), a filter strFileFilter (eg "*.tab", "*.*") and a string array to accept the string file directories.

You can download a copy of the source code here DirectoryScan.mb

Include "MAPBASIC.def"

Type FILETIME
   dwLowDateTime As Integer
   dwHighDateTime As Integer
End Type

Type
WIN32_FIND_DATA
   dwFileAttributes As Integer
   ftCreationTime As FILETIME   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Integer
   nFileSizeLow As Integer
   dwReserved0 As Integer
   dwReserved1 As Integer
   cFileName As String * 260   cAlternate As String * 14
End Type

Define
FILE_ATTRIBUTE_DIRECTORY 16

Declare Sub Main()

Declare Function GetFileList(ByVal strFilePath as String, ByVal strFileFilter as String, strFileList() as String) as Logical

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Integer

Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Integer, lpFindFileData As WIN32_FIND_DATA) As Integer

Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Integer) As Integer
'------------------------------------------------------------------------------------------------
Sub Main()
OnError Goto CatchEx

   Dim bResult As Logical
   Dim strDir As String
   Dim saFileNames() as String
   Dim i as integer
  
   Print chr$(12)
  
   strDir = "C:\Temp\"

   bResult = GetFileList(strDir, ".tab" , saFileNames())
  
   If bResult = True Then
     
      For i = 1 to UBound(saFileNames())
         Print i & ": " & saFileNames(i)
      Next

      Note "Total files found: " & UBound(saFileNames())
  
   Else
      Note strDir & " Doesn't Exist"
   End If

Done:
   Exit Sub

CatchEx:
   Note Error$()
   Resume Done
End Sub
'------------------------------------------------------------------------------------------------
Function GetFileList(ByVal strFilePath as String, ByVal strFileFilter as String, strFileList() as String) as Logical
OnError Goto CatchEx

   Dim hFind As Integer
   Dim wfd As WIN32_FIND_DATA Dim strFileName as String

   Dim iReturn as Integer
   iReturn = 1
  
   Dim i as Integer
   i = 1

   Dim strSubDirFileList() as String

   Dim j as Integer

   hFind = FindFirstFile(strFilePath & "*.*", wfd)

   strFileName = LTrim$(RTrim$(wfd.cFileName))
  
   If Len(strFileName) > 0 Then

      Do While iReturn <> 0

         If strFileName = "." or strFileName = ".." then
            iReturn = FindNextFile(hFind, wfd)strFileName = LTrim$(RTrim$(wfd.cFileName))
         Else
         strFileName = LTrim$(RTrim$(wfd.cFileName))
            If wfd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
               iReturn = GetFileList(strFilePath & strFileName & "\", strFileFilter, strSubDirFileList())
               For j = 1 to Ubound(strSubDirFileList)
                  ReDim strFileList(i)
                  strFileList(i) = strSubDirFileList(j)
                  i = i + 1
               Next
              iReturn = FindNextFile(hFind, wfd)
            Else
               If Right$(strFileName, Len(strFileFilter)) = strFileFilter then
                  ReDim strFileList(i)strFileList(i)= strFilePath & strFileName
                  i = i + 1
               End If
               iReturn = FindNextFile(hFind, wfd)
            End If
         End If
      Loop
   End If

   iReturn = FindClose(hFind)
   GetFileList = true

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Function
'------------------------------------------------------------------------------------------------

Monday, 20 January 2014

Debug logging example for Mapbasic

In this post I will demonstrate an example debugging method that allows developers to enable logging to the message window and switch it off when released to the users.

I personally have used similar implementations for development and find it very useful for debugging errors on a client machine.

The example code can be downloaded from here DebugLoggingExample.zip

INSTRUCTIONS:

The mbx will run and create a toolbar like this


To enable degug logging create a text file in the mbx directory called 'DEBUG' with no file extension (see download for example)

To initialise debug mode there is a call to the EnableDebugMode sub routine. If the DEBUG file exists, the global variable gDebugModeEnabled is set to true.

Every time you call the DebugLog() sub routine, if gDebugModeEnabled is equal to true, the string message parsed to the sub routine will be printed to the message window.

This example iterates through a for loop counting to 3. If debug logging is enabled the message window will look something like this.





















Example code below:

Include "MAPBASIC.DEF"
Include "ICONS.DEF"
Include "MENU.DEF"

Declare Sub Main
Declare Sub TestDebugLogging
Declare Sub EnableDebugMode
Declare Sub DebugLog(ByVal strMsg as String)

Define APP_BUTTONPAD_NAME "Debug Logging Example"

Global gDebugModeEnabled as Logical
'--------------------------------------------------------------------------------
Sub Main
OnError goto CatchEx
  
   Call EnableDebugMode
  
   Create ButtonPad APP_BUTTONPAD_NAME As
      PushButton HelpMsg "\nExample of Debug Logging"
      Calling TestDebugLogging
      Icon MI_ICON_WRENCH_2
      Position(3,3)
      Show

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'-------------------------------------------------------------------------------
Sub TestDebugLogging
OnError goto CatchEx
   Call DebugLog("Entered Sub TestDebugLogging")
  
   Dim i as Integer
   Dim strMsg as String
  
   Call DebugLog("Begin counting to 3")
 
   For i = 1 to 3
      Note i
      Call DebugLog("i = " & i)
   Next
  
   Call DebugLog("Completed counting to 3")

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'------------------------------------------------------------------------------
Sub EnableDebugMode
OnError Goto CatchEx
  
   gDebugModeEnabled = false

   If FileExists(ApplicationDirectory$() & "DEBUG") then 'Check if DEBUG file exists
      gDebugModeEnabled = true 'Set the global variable
      Print Chr$(12) 'Clear the message window
   End If

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'------------------------------------------------------------------------------
Sub DebugLog(ByVal strMsg as String)
OnError Goto CatchEx
   If gDebugModeEnabled then
      Print FormatDate$(CurDate()) & " @ " & Time(12) & ": " & strMsg
   End If

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'-----------------------------------------------------------------------------

Wednesday, 15 January 2014

How to generate an HTML page from Mapbasic

In this post I will demonstrate how to generate an HTML page from within Mapbasic and open it in Internet explorer. 

You can download the sample code from here ExampleHTML.mb

This mbx generates static html code that is opened in Internet explorer. I have used similar code to this to generate reports and elegantly style help documentation for an mbx. By including detailed css and javascript in your page you can style tables, group data, add images and even have interactive controls (this is obviously dependent on your web development experience).


Include "MAPBASIC.DEF"
Include "ICONS.DEF"
Include "MENU.DEF"

Declare Sub Main
Declare Sub ShowHtmlPage
Declare Sub ExitExample

'--------------------------------------------------------------------------------------
Sub Main

   Create Menu "Example HTML" As
      "Show Example html" Calling ShowHtmlPage,
      "(-",
      "Exit Example" Calling ExitExample
 
   Alter Menu Bar Add "Example HTML"

End Sub
'--------------------------------------------------------------------------------------
Sub ShowHtmlPage
OnError Goto CatchEx

    Dim strHtml as String

    'HTML~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

     strHtml = "<!DOCTYPE html>" & Chr$(13) &
                    "<html>" & Chr$(13) &
                       "<head>" & Chr$(13) &
                          "<title>Example HTML</title>" & Chr$(13) &
                          "<style type=" & Chr$(34) & "text/css" & Chr$(34) & ">" & Chr$(13) &
                          "h1 {color:#40B3DF;}" & Chr$(13) &
                          "h2 {color:black;font-family:" & Chr$(34) & "Arial" & Chr$(34) & ";}"
                          & Chr$(13) &
                          "p {color:black;font-family:" & Chr$(34) & "Arial" & Chr$(34) & ";}"
                          & Chr$(13) &
                         "</style>" & Chr$(13) &
                       "</head>" & Chr$(13) &
                   "<body>" & Chr$(13) &
                       "<h1>Example HTML</h1>" & Chr$(13) &
                       "<h2>Heading</h2>" & Chr$(13) &
                       "<p></p>" & Chr$(13) &
                       "<p>This is an example snippet of code to show how easy it is to create " &
                       "a html page using MapBasic. </p>" & Chr$(13) &
                   "</body>" & Chr$(13) &
                 "</html>"

     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Dim strTempHtmlFile as String
strTempHtmlFile = GetFolderPath$ (FOLDER_MYDOCS) & "\~example.html"

Open File strTempHtmlFile For Output as #1
   Print #1, strHtml
Close File #1

Dim bInternetExplorerExists as Logical
bInternetExplorerExists = false

Dim strInternetExplorerDir as String

If FileExists("C:\Program Files (x86)\Internet Explorer\iexplore.exe") then
    strInternetExplorerDir = "C:\Program Files (x86)\Internet Explorer\iexplore.exe"
    bInternetExplorerExists = true
End If

If FileExists("C:\Program Files\Internet Explorer\iexplore.exe") then
   strInternetExplorerDir = "C:\Program Files\Internet Explorer\iexplore.exe"
   bInternetExplorerExists = true
End If

If NOT bInternetExplorerExists then
   Note "Cannot display the html file because internet explorer is not installed!"
Else
   Run Program strInternetExplorerDir & " " & strTempHtmlFile
End If

Done:
   Exit Sub
CatchEx:
   Note Error$()
   Resume Done
End Sub
'--------------------------------------------------------------------------------------
Sub ExitExample
   End Program
End Sub
'--------------------------------------------------------------------------------------

If you have any questions please don't hesitate to ask

Cheers

James

Monday, 13 January 2014

Read, Write, Search and Delete Registry Keys using Mapbasic and Windows API

In this post I will explain briefly how to access the windows registry using the Window API within Mapbasic. The example code below demontrates how to read a registry key, write a registry key and delete a registry key.

It is expected that you have a good understanding of developing within Mapbasic. This code could be used for setting up a licence key or storing information about toolbar position. I hope this is useful to someone.

Warning: If you know nothing about the window registry it is recommended that you read up before implementing this code. I accept no responsibility if you destroy your registry.

To download a copy of the source code click here RegistryExample.mb

The windows dll used to access the registry is advapi32.dll

The methods used are;

RegOpenKeyA
RegCloseKey
RegCreateKeyA
RegDeleteValueA
RegQueryValueExA
RegSetValueExA

This is the example test harness dialog:








The Create button will generate a new registry key in HKEY_CURRENT_USER\Software\Mapbasic\ExampleKey.

The code in the RegistryExample.mb example that generates the key uses method RegCreateKeyA.
 
Dim iResult as Integer
Dim hKey as Integer

iResult = RegCreateKey(hKeyRoot,strKeyPath,hKey)

iResult will return 0 if successful, otherwise a number greater than 0 will be returned. hKey contains the integer reference to the newly generated key (hKey value is used to set, query and delete keys later in the code).


Note: To access the registry editor type regedit in the start search

To set the registry key value, type a value in the edit text box and click Set.

iResult = RegSetValueEx(hKey,strKeyName, 0, iKeyType, strData, Len(strData))


To query the registry key value click Get. The edit text box will be populated with the value.


iResult = RegQueryValueEx(hKey,strKeyName,0,iReturnType,strKeyValue,iReturnDataBufSize)



To delete the example key click Delete.

iResult =   RegDeleteValue(hKey,strKeyName)



Cancel will end the mbx.

TRAPS:
I found that when you query using RegQueryValueEx you must pad your return string and parse in a large buffer size, otherwise an erroneous result will be returned indicating that the response is bigger than the buffer allocated. Not normally something you have to worry about in MapBasic but we are calling function in an unmanaged fashion. 

Dim iReturnDataBufSize As Integer
iReturnDataBufSize = 2147483646 'Max Integer Size
Dim strKeyValue As String
strKeyValue = String$(255," ")

I hope the code is fairly self explanatory and if anyone has any questions don't hesitate to comment.

Cheers

James