Topics - Gerome [ switch to compact view ]

Pages: [1] 2 3 4 5 6 7 • next
1
Developer's Corner / [FBSL] Environment class - for scripting support
« on: October 05, 2006, 03:13 PM »
Hello,

A great FBSL fan (Ferdinand Piatnik) has developped a very nice tool with it.
This is a 'shell' program like that does a lot of nice things.

Here is the whole description + source code + zipped attachement.

I propose class env as a tool to use with FBSL programs in BAT files.
When instance of class env is created it processes the FBSL program command parameters.
Features are:
options - parameters which begin with with "-" are treated as options.
First character after "-" is saved as option identification, the reminder of parameted is saved as option argument.
Options are processed until non option parameter is found.
fileset expansion - parameters which contain "*" or "?" joker characters are considered as fileset definition
and are expanded to list of files.
Joker characters are allowed anywhere in directory path(except for drive specification)
standard input redirection - parameter which starts with "<" defines STDIN file.
Parameter must be enclosed in quotes(") because of standard DOS(cmd.exe) processing.
standard output redirection - parameter which starts with ">" defines STDOUT file.
When parameter starts with >> then standard output is appended to specified file.
Parameter must be enclosed in quotes(") because of standard DOS(cmd.exe) processing.

These features are not enabled by default.
The Initialize method has three parameters:
%flags - sum of following flags is recognized at this time (-1 covers any present or future options):
env.C_OPT - option proccessing is enabled
env.C_FILES - fileset proccessing is enabled
env.C_STDIO - standard input/output proccessing is enabled
env.C_ESC - escaping of any proccessing is enabled(by prefixing parameter by character "/")
%fAllow - specifies file attributes which are allowed for files to be returned in fileset (when fileset expansion is enabled)
Default value is FILE_ATTRIBUTE_ARCHIVE+FILE_ATTRIBUTE_READONLY
%dAllow- specifies file attributes which are allowed for directories to be examined (when fileset expansion is enabled)
Default values is FILE_ATTRIBUTE_DIRECTORY+FILE_ATTRIBUTE_READONLY

Class env exposes following constants:

C_STDIO = 1 'allow redirection of STDIN, STDOUT
C_FILES = 2 'expand parameters with * and ?
C_ESC = 4 'parameters starting with \ are not processed(\ is trimmed off)
C_OPT = 8 'leading parameters starting with - are processed as options

Methods:

Method getFiles - returns array of files
Parameters:
$fname - file search string - it may contain "*" and "?" characters
$dir (default="") - directory string prepended to search string - must end with "\" ,
"*" and "?" characters are not allowed/processed
%fAllow (default=FILE_ATTRIBUTE_ARCHIVE+FILE_ATTRIBUTE_READONLY)
specifies file attributes which are allowed for files to be returned in fileset
%dAllow(default=FILE_ATTRIBUTE_DIRECTORY+FILE_ATTRIBUTE_READONLY)
specifies file attributes which are allowed for directories to be examined

Method redirectStdIn - specifies standard input file. True is returned if redirection succedes, false otherwise.
Parameter:
$p_fileName (default="")- specifies STDIN file. When "" then default STDIN is restored.

Method redirectStdOut - specifies standard output file. True is returned if redirection succedes, false otherwise.
Parameters:
$p_fileName (default="")- specifies STDOUT file.When "" then default STDOUT is restored.
$p_mode (default="w") - specifies write mode. When "w" text is written to new file. If "a" is specified, then text is appended to existing file.

Method printError writes text to FBSL console even if STDOUT is redirected.
Parameters:
$p_message - text to be written
$p_CRLF - (default=CRLF) - text to be appended to p_message

I could not find problems on my computer.
There is a bug/problem with use of _dup2 function for STDIN, but workaround with use of fflush corrected problems.

In Attachment there are files:
env.inc - env class definition
envDemo.fbs - demo FBSL script - called by demo.bat
demo.bat - BAT script to demonstrate uses of env class. If I knew how, I would make it better.

The Class code :
Code: Text [Select]
  1. Class env
  2.         #DllDeclare crtdll(_dup As myDup, _dup2 As myDup2, _fileno As myFileNo, fopen As myFopen, fflush As myFflush)
  3.         #DllDeclare kernel32(GetStdHandle, WriteConsole)
  4.         'http://msdn2.microsoft.com/en-us/library/8syseb29.aspx
  5.         '
  6.         Private
  7.         Shared  %d_stdIn = 0, %d_dupStdIn, %d_newStdIn = 0, %d_stdOut = 0, %d_dupStdOut, %d_newStdOut = 0
  8.         Shared  %d_errHandle = 0
  9.         '
  10.         Function redirect_($p_fileName, $p_mode, %p_old, %p_dup, %p_new)
  11.                 Const FAIL = -1
  12.                 Const NONE = 0
  13.                 Dim %d_tmp, d_handle
  14.                 If p_mode = "r" Then
  15.                         d_handle = STDIN
  16.                 Else
  17.                         d_handle = STDOUT
  18.                 End If
  19.                 If p_old = 0 Then 'get file descriptor and its duplicate  
  20.                         p_old = myFileNo(d_handle)
  21.                         p_dup = myDup(p_old)
  22.                 End If
  23.                 If p_fileName = "" Then ' restore old
  24.                         If p_new <> 0 Then
  25.                                 myFflush(d_handle)
  26.                                 If myDup2(p_dup, p_old) = -1 Then
  27.                                         Return(FALSE)
  28.                                 End If
  29.                                 p_new = 0
  30.                         End If
  31.                 Else
  32.                          %d_tmp = myFopen(p_fileName, p_mode) ' open new file
  33.                         If d_tmp = NONE Then Return(FALSE) 'failed to open file
  34.                          %d_tmp = myFileno(d_tmp) ' get file descriptor from file pointer
  35.                         If  %d_tmp = FAIL Then ' 'failed to get file descriptor
  36.                                 Return(FALSE)
  37.                         Else
  38.                                 If myDup2(d_tmp, p_old) = FAIL Then Return(FALSE) 'failure
  39.                                 p_new = d_tmp
  40.                         End If
  41.                 End If
  42.                 Return(TRUE)
  43.         End Function
  44.        
  45.         Method Initialize(%flags = 0, _
  46.                 %fAllow = FILE_ATTRIBUTE_ARCHIVE + FILE_ATTRIBUTE_READONLY, _
  47.                 %dAllow = FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_READONLY)
  48.                 Dim %f_stdio = flags BAnd C_STDIO
  49.                 Dim %f_files = flags BAnd C_FILES
  50.                 Dim %f_esc = flags BAnd C_ESC
  51.                 Dim %f_opt = flags BAnd C_OPT
  52.                 Dim %i, $v, %ok, $fin = "", $fout = "", $mode = ""
  53.                 argv[] = Command(1 - STANDALONE)
  54.                 For i = 2 - STANDALONE To CommandCount() - 1
  55.                         ok = TRUE
  56.                         v = Command(i)
  57.                         If f_esc Then
  58.                                 If v{1} = "/" Then
  59.                                         ok = FALSE
  60.                                         f_opt = FALSE
  61.                                         argv[] = Mid(v, 2)
  62.                                 End If
  63.                         End If
  64.                         If ok Then
  65.                                 If f_opt Then
  66.                                         If v{1} = "-" Then
  67.                                                 If Mid(v, 2, 1) <> "" Then
  68.                                                         options = options & Mid(v, 2, 1)
  69.                                                         optv[] = Mid(v, 3)
  70.                                                 End If
  71.                                                 ok = FALSE
  72.                                         Else
  73.                                                 f_opt = FALSE
  74.                                         End If
  75.                                 End If
  76.                         End If
  77.                         If ok Then
  78.                                 If f_stdio Then
  79.                                         If v{1} = ">" Then
  80.                                                 ok = FALSE
  81.                                                 If v{2} = ">" Then
  82.                                                         fout = Mid(v, 3)
  83.                                                         mode = "a"
  84.                                                 Else
  85.                                                         fout = Mid(v, 2)
  86.                                                         mode = "w"
  87.                                                 End If
  88.                                         ElseIf v{1} = "<" Then
  89.                                                 ok = FALSE
  90.                                                 fin = Mid(v, 2)
  91.                                         End If
  92.                                 End If
  93.                         End If
  94.                         If ok Then
  95.                                 If f_files Then
  96.                                         If Instr(v, "*") Or Instr(v, "?") Then
  97.                                                 argv = Array_Merge(argv, getFiles(v, "", fAllow, dAllow))
  98.                                                 ok = FALSE
  99.                                         End If
  100.                                 End If
  101.                         End If
  102.                         If ok Then
  103.                                 argv[] = v
  104.                         End If
  105.                 Next
  106.                 argc = Count(argv)
  107.                 If fin <> "" Then redirectStdIn(fin)
  108.                 If fout <> "" Then redirectStdOut(fout, mode)
  109.         End Method
  110.         '
  111.         Public
  112.        
  113.        
  114.         Dim options = "", optv[], argv[], %argc = 0
  115.         Begin Const
  116.                 C_STDIO = 1 'allow redirection of STDIN,STDOUT
  117.                 C_FILES = 2 'expand parameters with * and ?
  118.                 C_ESC = 4 'parameters starting with \ are not processed(\ is trimmed off)
  119.                 C_OPT = 8 'leading parameters starting with - are processed as options
  120.         End Const
  121.        
  122.         Method getFiles($fname, $dir = "", _
  123.                 %fAllow = FILE_ATTRIBUTE_ARCHIVE + FILE_ATTRIBUTE_READONLY, _
  124.                 %dAllow = FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_READONLY)
  125.                 #DllDeclare crtdll("_findfirst" As myFFirst, "_findnext" As myFNext, "_findclose" As myFClose)
  126.                 'http://msdn2.microsoft.com/en-us/library/kda16keh.aspx
  127.                 'fname - path string with optional * and ? joker characters at any position
  128.                 'dir - optional base directory - no joker characters allowed (must end with \)
  129.                
  130.                 Dim arr[]
  131.                 Dim %p, %pJoker, %pRest = 0
  132.                 Dim $path = dir, $search = fname, $rest, $f
  133.                 Dim %fMask = BNot fAllow, %dMask = BNot dAllow
  134.                 Dim %fStat, %fHandle, %attr, %searchHandle, $fileInfo * MAX_PATH + 41
  135.                 'are there any joker characters?
  136.                 pJoker = Instr(search, "*")
  137.                 p = Instr(search, "?")
  138.                 If p And p < pJoker Then pJoker = p
  139.                 '
  140.                 If pJoker Then 'jokers exist in search
  141.                         p = InstrRev(search, "\", pJoker)
  142.                         If p Then
  143.                                 path = dir & Left(search, p) 'set new base directory
  144.                                 search = Mid(search, p + 1)
  145.                         End If
  146.                         pRest = Instr(search, "\") 'is joker for directory?
  147.                         If pRest Then 'directory with joker characters
  148.                                 rest = Mid(search, pRest + 1)
  149.                                 search = Left(search, pRest - 1)
  150.                         End If
  151.                 End If
  152.                 fHandle = myFFirst(path & search, @fileInfo)
  153.                 fStat = fHandle
  154.                 While fStat <> -1
  155.                         'f =TO_LPSTR( @fileInfo+20)
  156.                         If f{1} <> "." Then
  157.                                 attr = GetMem(fileInfo, 0, %4)
  158.                                 If pRest Then
  159.                                         If Not (attr BAnd dMask) And (attr BAnd FILE_ATTRIBUTE_DIRECTORY) Then arr = Array_Merge(arr, getFiles(rest, path & To_Lpstr(@fileInfo + 20) & "\", fAllow, dAllow))
  160.                                 Else
  161.                                         If Not (attr BAnd fMask) Then arr[] = path & To_Lpstr(@fileInfo + 20)
  162.                                 End If
  163.                         End If
  164.                         fStat = myFnext(fHandle, @fileInfo)
  165.                 Wend
  166.                 If fHandle <> -1 Then myFClose(fHandle)
  167.                 Return arr
  168.         End Method
  169.        
  170.         Method printError($p_message, p_CRLF = CRLF)
  171.                 Dim %d_len, d_buf = $p_message & p_CRLF
  172.                 If d_errHandle = 0 Then d_errHandle = GetStdHandle(STD_ERROR_HANDLE)
  173.                 WriteConsole(d_errHandle, @d_buf, StrLen(d_buf), @d_len, 0)
  174.         End Method
  175.        
  176.         Method redirectStdIn($p_fileName = "")
  177.                 Return(redirect_(p_fileName, "r", d_stdIn, d_dupStdIn, d_newStdIn))
  178.         End Method
  179.        
  180.         Method redirectStdOut($p_fileName = "", $p_mode = "w")
  181.                 Return(redirect_(p_fileName, p_mode, d_stdOut, d_dupStdOut, d_newStdOut))
  182.         End Method
  183. End Class

2
Developer's Corner / [FBSL] LZO compressor
« on: October 01, 2006, 08:39 AM »
Hello,

Here is a simple demonstration of native LZO engine compression/decompression implemented into FBSL.
Enjoy!

Code: Text [Select]
  1. #Option Explicit
  2. #AppType Console
  3.  
  4. '// ****************************************************************************
  5. '// Simple demonstration of native LZO engine compression/decompression implemented into FBSL
  6. '// Author : Gerome GUILLEMIN
  7. '// Date : 1st of October 2006
  8. '// ****************************************************************************
  9. Dim buff, fp
  10.  
  11. Print "LZO compress..."
  12. buff = Compress(FileLoad(".\18 - Wedding idea.mp3"))
  13.  
  14. If buff <> "" Then
  15.         fp = FileOpen(".\compressed.lzo", BINARY_NEW)
  16.         If fp Then
  17.                 FilePut(fp, buff)
  18.                 FileClose(fp)
  19.         End If
  20. End If
  21. Clear buff
  22. fp = NULL
  23. Pause
  24.  
  25. Print "LZO decompress..."
  26. buff = Decompress(FileLoad(".\compressed.lzo"))
  27. If buff <> "" Then
  28.         fp = FileOpen(".\decompressed.mp3", BINARY_NEW)
  29.         If fp Then
  30.                 FilePut(fp, buff)
  31.                 FileClose(fp)
  32.         End If
  33. End If
  34. Clear buff
  35. fp = NULL
  36. Pause

3
Developer's Corner / Tiny 'Touch' 32 bits program in C (3 kb)
« on: September 29, 2006, 02:58 PM »
Hello,

For people who are aware of having an Unix like 'Touch' program, here are the sources + into the zipped attachement, a BAT to compile the source, the compiled source (a 3Kb one) :)

Code: C [Select]
  1. // ********************************
  2. // Author : Gerome GUILLEMIN
  3. // Coded in pure C using LCC Win32
  4. // Date : 29 th of September 2006
  5. // ********************************
  6. #include <windows.h>
  7. #include <stdio.h>
  8.  
  9. BOOL SetFileToCurrentTime(HANDLE);
  10.  
  11. int main(int argc, char **argv)
  12. {
  13.         HANDLE lngHandle = NULL;
  14.         char szFileName[MAX_PATH+1];
  15.         if ( argc == 2 ) {
  16.                 strcpy( szFileName, argv[1] );
  17.             lngHandle = CreateFile(szFileName, GENERIC_WRITE,
  18.                                         FILE_SHARE_READ | FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0);
  19.                 if (lngHandle && lngHandle != INVALID_HANDLE_VALUE) {
  20.                         SetFileToCurrentTime( lngHandle );
  21.                         CloseHandle( lngHandle );
  22.                         return 1; // => 1 will be the OK return
  23.                 }
  24.         }
  25. return 0; // => 0 will be the KO return
  26. }
  27.  
  28. BOOL SetFileToCurrentTime(HANDLE hFile)
  29. {
  30.   FILETIME ft;
  31.   SYSTEMTIME st;
  32.  
  33.   GetSystemTime(&st);                 // gets current time
  34.   SystemTimeToFileTime(&st, &ft);     // converts to file time format
  35.   return SetFileTime(hFile,           // sets last-write time for file
  36.          (LPFILETIME)NULL, (LPFILETIME)NULL, &ft);
  37. }

4
Developer's Corner / [FBSL] FARR's Calc tool updated!
« on: September 26, 2006, 04:25 AM »
Hello,

I've improved my FARR's calculator!

Here's the link : http://gedd123.free.fr/Fbsl/DC/FBSLCalc_16-09.zip

How to install Fbslcalc.fbs into FARR ?
-1- Copy FBSLCalc.exe into \FindAndRunRobot\Scripts\
-2- Open FARR and edit Option, select the 'calc'item,and replace its regex config with this one :
calc $$1 | Scripts/FBSLCalc.exe "$$1"
-3- Save

That'all folks!
Now you can play with the newest calc :)

Usage : FBSLCalc.exe expression

Examples :
basic sample :
Calc 2+2
It'll return '4'

graphical sample :
calc /code=FBSL_Control("Button", Me, "Hello", 1000, 10, 10, 75, 23, 0, 0):show(me):begin events:If CBMsg = WM_COMMAND And CBCTL =1000 then msgbox(0, "Button clicked!", "yoo", 0):end events
it'll afx a form with a button, then just click onto the button... :)

sample sample :
calc /code=ExecLine(FileLoad("./PMem.fbs"))

Enjoy!

Here is the source of the newest FARR's calc :
Code: Text [Select]
  1. #Option Explicit
  2. '#AppType Console
  3.  
  4. If Not STANDALONE Then
  5.     Fbsl2Exe( Command(1) ): ExitProgram(0)
  6. End If
  7.  
  8. '// -----------------------------------------------------------------
  9. '// GEG 26 September 2006
  10. '// FBSLCALC.EXE 2.5/56*PI
  11. '// FBSLCALC.EXE /code=msgbox(Null,"Hello","Test",MB_ICONINFORMATION)
  12. '// -----------------------------------------------------------------
  13. Static $code, $resulttext, $result, $cmd = Command(-1), ch34 = Chr(34), ch92 = Chr(92)
  14. If cmd = "" Then
  15.     MsgBox(NULL, "You need to specify an expression to evaluate, like 2+2." & crlf & _
  16.                 "If you encounter any problems, tell'em there : " & crlf & _
  17.                 "http://www.fbsl.net/phpbb2/index.php", _
  18.                 "Freestyle Basic Script Langage (FBSL) Calculator:", MB_OK +MB_ICONINFORMATION)
  19.     ExitProgram(1)
  20. End If
  21.  
  22. cmd = Replace(cmd, ch34 & ch34, "")
  23. If Left(cmd, 1) = ch34 AndAlso Right(cmd, 1) = ch34 Then
  24.     cmd = Mid(cmd, 2, StrLen(cmd) - 2)
  25. End If
  26.  
  27. If Instr(cmd,"/code=") Then
  28.     cmd = Remove(Trim(cmd), "/code=")
  29.     code = "result = " & cmd & " : Return result"
  30.     resulttext = cmd & " = " & ExecLine(code)
  31. Else
  32.     cmd = Replace(Trim(cmd), ",", ".")
  33.     code = "result = " & cmd & " : Return result"
  34.     ExecLine(code)
  35.     result = Replace(result, ".", GetLocalSeparator())
  36.     resulttext = cmd & " = " & result
  37. End If
  38.  
  39. If StrLen(cmd) = 0 Then ExitProgram(-1)
  40.  
  41. ClipboardSetText(result)'resulttext)
  42. MsgBox(NULL, resulttext, "Freestyle Basic Script Langage (FBSL) Calculator / Executor:", _
  43.        MB_OK+MB_ICONINFORMATION)
  44.  
  45. Function GetLocalSeparator()
  46.     Dim $Buffer * 4
  47.     ApiCall( "GetNumberFormat", "kernel32", 0, 0, "1.1", 0, @Buffer, Len(Buffer) )
  48.     Return Mid(Buffer,2,1)
  49. End Function

5
Developer's Corner / [FBSL] Submit your scripts online
« on: September 24, 2006, 04:03 PM »
Hello,

I've made a graphical application 100% with FBSL that is able to submit your scripts onto an online mySQL database.
Your typed (or picked from disk) script can be submitted online via a simple command button.
More than comments, here are two screenshots that show how this tiny application works.

At first type your code / or pick it from your disk :


And then, admire the submitted sample directly from the Web :


Enjoy!

Pages: [1] 2 3 4 5 6 7 • next
Go to full version