topbanner_forum
  *

avatar image

Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
  • Friday March 29, 2024, 8:32 am
  • Proudly celebrating 15+ years online.
  • Donate now to become a lifetime supporting member of the site and get a non-expiring license key for all of our programs.
  • donate

Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - Gerome [ switch to compact view ]

Pages: prev1 [2]
26
Hello,

Always dreamed about getting DLL exported functions ?

Here's the code to get'em :
'###################################
' Display DLL Exports
'###################################
Option Explicit
#DLLDECLARE imagehlp("ImageDirectoryEntryToData")
Dim $IMAGE_EXPORT_DIR,%BaseAddress,%pExportDirectory,%pSize
Dim $ExportNamePointerTable,$namefunc,%t,$filename
Dim %hList,$LV_ITEM,$sSave,%hStatus,%hMenu,%FileMenu,$filename,$divide

Begin Const
    ID_OPEN                      = 1001
    ID_EXIT                      = 1002
    LVSCW_AUTOSIZE               = -1
    LVS_LIST                     = 0x0003
    LVIF_TEXT                    = 0x1
    LVIF_IMAGE                   = 0x2
    LVS_REPORT                   = 0x0001
    LVS_TYPEMASK                 = 0x3
    LVS_EX_GRIDLINES             = 0x1
    LVS_EX_FULLROWSELECT         = 0x20
    LVS_EX_LABELTIP              = 0x00004000
    LVS_NOSORTHEADER             = 0x8000
    IMAGE_DIRECTORY_ENTRY_EXPORT = 0
End Const

Fbsl_Settext(Me,"DLL Exports")
hMenu = CreateMenu()
FileMenu = CreateMenu()
AppendMenu( FileMenu, MF_String,ID_OPEN, "&Open")
AppendMenu( FileMenu, MF_SEPARATOR,0, "")
AppendMenu( FileMenu, MF_String,ID_EXIT, "&Exit")
InsertMenu(hMenu,1,MF_PopUp, FileMenu, "&File")
SetMenu( Me,hMenu)

Alloc(LV_ITEM,36)
Alloc(IMAGE_EXPORT_DIR,40)
Alloc(ExportNamePointerTable,5120)
Alloc(namefunc,255)
Alloc(divide,12)
SetMem(LV_ITEM,LVIF_TEXT,0)

Resize(Me,0,0,420,420)
hList = FBSL_Control("SysListView32",Me,"",0,10,10,400,350,_
    WS_VISIBLE + WS_CHILD + LVS_LIST + LVS_TYPEMASK + LVS_NOSORTHEADER,WS_EX_STATICEDGE)
hStatus = FBSL_Control("msctls_statusbar32",Me,"",0,0,0,0,0,WS_VISIBLE + WS_CHILD,0)
FBSL_SetFont(hList,"Lucida Console",12,FW_NORMAL,0,0,0)

SendMessage(hList,LVM_SETCOLUMNWIDTH,0,LVSCW_AUTOSIZE)
SendMessage(hList,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_LABELTIP )
SendMessage(hList,LVM_SETBKCOLOR,0,rgb(234,230,230))
SendMessage(hList,LVM_SETTEXTBKCOLOR,0,rgb(234,230,230))

SetMem(divide,250,0): SetMem(divide,420,4)
SendMessage(hStatus,SB_SETPARTS,2,divide)
ModStyle(Me,0,WS_SIZEBOX,0)
Center(Me): Show(Me)

Begin Events
    Select Case cbmsg
        Case WM_COMMAND
            If CBCTL = ID_OPEN Then
                SendMessage(hList,LVM_DELETEALLITEMS,0,0)
                filename = FBSL_GetFileName( "Open", "DLL File|*.dll", 0)
                BaseAddress = LoadLibrary(filename)
                pExportDirectory = ImageDirectoryEntryToData(BaseAddress,1,_
                                    IMAGE_DIRECTORY_ENTRY_EXPORT,@pSize)
                MemMove(IMAGE_EXPORT_DIR,pExportDirectory,40)
                Alloc(ExportNamePointerTable, GetMem(IMAGE_EXPORT_DIR,24,4) * 4)
                memmove(ExportNamePointerTable, BaseAddress + GetMem(IMAGE_EXPORT_DIR,32,4),_
                        GetMem(IMAGE_EXPORT_DIR,24,4) * 4)
                For t = 0 To GetMem(IMAGE_EXPORT_DIR,24,4) - 1
                    MemMove(namefunc,BaseAddress + GetMem(ExportNamePointerTable,t * 4,4),255)
                    SetMem(LV_ITEM,t,4)
                    SetMem(LV_ITEM,@namefunc,20)
                    SendMessage(hList,LVM_INSERTITEM,0,LV_ITEM)
                Next
                SendMessage(hStatus,SB_SETTEXT,0,filename)
                SendMessage(hStatus,SB_SETTEXT,1,"Number of Functions: " &_
                            GetMem(IMAGE_EXPORT_DIR,24,4))
                FreeLibrary(BaseAddress)
                Erase ExportNamePointerTable
        End If
        If CBCTL = ID_EXIT Then EXITPROGRAM(0)
    End Select
End Events

And here's a screenshot to see the result of the KERNEL32.DLL captured :


Enjoy ;)

27
Developer's Corner / FBSL - a simple Web browser
« on: February 09, 2006, 04:45 PM »
Hello,

Fbsl is able to create controls on the fly thanks to its API capacity to dialog with and thanks to the rich funds that Windows has, I'll show you how easy it is to embedd a web browser component with Fbsl and thanks to ATL APIs...
Get ready... ?

At first, here's the script :
'$AppType GUI
option explicit
$DLLDeclare ATL.AtlAxWinInit
Dim %hDisplay, $URL

FBSL_SetText(Me, "==FBSL Basic Web Browser==")
ReSize(Me, 0, 0, 600, 500)
Center(Me)

Const hURL = FBSL_Control("Edit", Me, "http://www.fbsl.net", 0, 10, 3, 368, 23, _
             WS_Child + WS_Visible + WS_TabStop + ES_AutoHScroll, WS_Ex_ClientEdge)
Const IDB_Go = 1000
    FBSL_Control("Button", Me, "Go", IDB_Go, 380, 3, 75, 23, WS_Child + WS_Visible + WS_TabStop, 0)
    AtlAxWinInit(0)
    hDisplay = FBSL_Control("AtlAxWin", Me, "MSHTML:<HTML></HTML>",_
                0, 0, 30, 600, 460, WS_Child + WS_Visible, WS_Ex_ClientEdge)
Show(Me)
RefreshMe()

Begin Events
    Select Case CBMsg
        Case WM_Size
            RefreshMe()
        Case WM_Close
            ExitProgram(0)
        Case WM_Command
            If CBCtl = IDB_Go Then EventGo()
    End Select
End Events

Sub EventGo()
    FBSL_GetText(hURL, URL)
    If URL = "" Then Return
    If (hDisplay <> 0) Then Destroy(hDisplay)
    hDisplay = FBSL_Control("AtlAxWin", Me, URL, 0, 0, 30, 600, 460,_
               WS_Child + WS_Visible + WS_VScroll + WS_HScroll, WS_Ex_ClientEdge)
    RefreshMe()
End Sub

Sub RefreshMe()
Dim %Lefti, %Topi, %Righti, %Bottomi
   GetClientRect( Me, Lefti, Topi, Righti, Bottomi )
   ReSize(hDisplay, 10, 30, Righti - 25, Bottomi - 70)
End Sub

And then, here's the result :

28
Developer's Corner / FBSL - its own IDE
« on: February 09, 2006, 04:13 PM »
Hello,

FBSL has a built in editor coded in... FBSL :)
All in all, it is able to compile itself, decompile, bookmark, find & replace, change its appearance and much more!

Have a look !


It does look nice, doesn't it ?

29
Developer's Corner / FBSL - Net Send grabber + logger
« on: February 07, 2006, 04:55 PM »
Hello,

Sometimes, when you're at office without admin rights or poweruser rights, you are feeling kinda bitter...
And to send messages to your collegues, you have to use the NET SEND mycollegue TheMessage blahhh
to discuss a bit...
Yes, but exchnaging those kinda msg is heavy and not convivial, plus you can't grab the text that is just popped at screen...
I've found a solution !

I've developped a tiny GUI application that is in charge of scruting for incoming net sended messages, grabbing its very content, redirecting the message into a richedit control + logging the very content of the popped messages + closing the popped message !!!

Here's a screen shot of a just grabbed popped message :


Here's the main script that does the trick :
#Option Explicit
#DllDeclare User32( "EnumWindows", "GetWindowText", "GetWindowTextLength", _
                    "GetDlgItem", "SetFocus", "FindWindow", "FlashWindow" )

' // Replace with the correct translation here
Const service = "Service Affichage des messages "
Const sep     = "--------------------------------------------------------------------------------"
Const STYLE = WS_CHILD + WS_CLIPSIBLINGS + WS_VISIBLE + WS_HSCROLL + WS_VSCROLL + ES_MULTILINE + _
              ES_AUTOVSCROLL + ES_AUTOHSCROLL + WS_TABSTOP
LoadLibrary("Riched20.dll")
Dim %H = 420, %W = 220, $sGet, %fp
Resize( Me, 0, 0, H, W )
Dim hwndInput = FBSL_Control ( _
         "richedit20a", Me, "", 1000, 20, 20, H-40, W-40, STYLE, WS_EX_CLIENTEDGE )
Fbsl_settext( Me, "NET Send Capturer / logger" )
SetTimer(Me, 3615, 100)

fp = Fileopen( ".\Capturer.log", Append )

Center(Me): ResizeMe(): Show(Me)

Begin Events
    If cbmsg = wm_close Then
        Killtimer( Me, 3615 )
        Fileclose( fp )
        Exitprogram(0)
    End If
    If cbmsg = wm_timer Then
        MyGetNetSend()
    End If
    If cbmsg = wm_size Then
        ResizeMe()
    End If
End Events

Sub MyGetNetSend()
    Dim %hwnd = FindWindow(Null, service )
    Dim %Ret = GetWindowTextLength(hwnd)
    If Ret > 0 Then
        Dim $sSave, %hdlg
        sSave = Space(Ret)
        GetWindowText( hwnd, sSave, Ret + 1 )
        If Left(sSave, Len(service)) = service Then
            ' // Message Window
            hdlg = GetDlgItem( hwnd, 0xFFFF )
            Ret = GetWindowTextLength(hdlg)
            sSave = Space(Ret)
            GetWindowText( hdlg, sSave, Ret + 1 )
            Sendmessage( hwnd, WM_CLOSE, 0, 0 )
            Fbsl_Gettext( hwndInput, sGet )
            sGet = sGet & sSave & CrLf & sep & CrLf
            Fbsl_Settext( hwndInput, sGet )
            Fileprint( fp, sSave )
            FlashWindow( Me, True )
        End If
    End If
End Sub

Sub ResizeMe()
Dim %TopWin, %leftWin, %RightWin, %BottomWin
   GetClientRect(Me, TopWin, leftWin, RightWin, BottomWin )
   Resize( hwndInput, 20, 20, RightWin - 40, BottomWin - 60 )
End Sub

The only thing to adapt into that script will be this only line :
Const service = "Service Affichage des messages "

It was tested onto : NT4, Win2k and WinXP French versions with success :)
And what about you ? :)

Tell me please :)

30
Developer's Corner / All about FBSL!
« on: February 07, 2006, 03:46 PM »
Dear All,

I'm quite new here, i won't bother you, but i've noticed since i've been greatly granted to this wonderful place, that some people have been interested in my language aka FBSL

So, any remarks, questions, scripts and tidbits would be very welcomed here.

31
Developer's Corner / FBSL - XML Class
« on: February 07, 2006, 05:02 AM »
Hello,

Here's an XML Class to manipulate XML files under windows using XML DOM COM interface...

$Apptype CONSOLE
#Option Explicit


' ---------------------------------------------
' // Sample Test
' ---------------------------------------------
Dim %xml
CXml.Init()
xml = CXml.LoadXml( ".\Album.xml" )
    If CXml.myStrerr = "" Then
        CXml.GetNodeListCount( "title" )
        ? "The 1st 'title' of the 1st 'Album' tag is :", CrLf, CXml.GetNodeListItem(1), CrLf
        CXml.GetNodeListCount( "artist" )
        ? "Its 'artist' is :", CrLf, CXml.GetNodeListItem(1), CrLf       
    End If
CXml.Terminate()
Pause


' ---------------------------------------------
'// XML Class
' ---------------------------------------------
#region XML Class by Gerome GUILLEMIN
Class CXml()
Dim %myObj, %theNodeList, $myStrerr

    Sub Init()
        ComWarnings(False)
        myObj = CreateObject( "Microsoft.XMLDOM" )
        PutValue( myObj, ".async(%b)", False )
        PutValue( myObj, "ValidateOnParse = %b", True )
    End Sub

    Function %LoadXml( Byref $szXmlFileName ) 'As Object
        If myObj = False Then Return False
        If FileExist( szXmlFileName ) = False Then
            myStrerr = "File does not exist!"
            Return False
        End If
        CallMethod( myObj, ".Load(%s)", szXmlFileName )
        If GetValue( "%d", myObj, ".parseError.errorCode" ) <> False Then
            myStrerr = "Error at line : " & GetValue( "%d", myObj, ".parseError.line" ) & _
            GetValue( "%s", myObj, ".parseError.srcText" )
            Return False
        End If
        Return myObj
    End Function

    Function %GetNodeListCount( Byref $szNodeName )
        If myObj = 0 Then Return False
        If theNodeList <> False Then ReleaseObject(theNodeList)
        Set theNodeList = GetValue( "%o", myObj, ".getElementsByTagName(%s)", szNodeName )
        If theNodeList = False Then
            ReleaseObject(theNodeList)
            Return False
        Else
            Return GetValue( "%d", theNodeList, ".Length" )
        End If
    End Function

    Function $GetNodeListItem( Byref %theiTem )
        If myObj = 0 Then Return ""
        Return GetValue( "%s", theNodeList, ".item(%d).text", theiTem-1 )
    End Function

    Sub Terminate()
        If theNodeList <> False Then ReleaseObject(theNodeList)
        If myObj <> False Then ReleaseObject(myObj)
        myStrerr = ""
        ComWarnings(True)
    End Sub

End Class
' ---------------------------------------------
#endregion
' ---------------------------------------------

To test this class, you need the following XML file (saved as 'album.xml') :
<?xml version="1.0"?>
<Albums>
   <Album ref="CD142" category="Folk">
      <title>Boil The Breakfast Early</title>
      <artist>The Chieftains</artist>
   </Album>
   <Album ref="CD720" category="Pop">
      <title>Come On Over</title>
      <artist>Shania Twain</artist>
   </Album>
   <Album ref="CD024" category="Country">
      <title>Red Dirt Girl</title>
      <artist>Emmylou Harris</artist>
   </Album>
</Albums>

Enjoy FBSL :)

32
Developer's Corner / FBSL - How to embedd a flash PACMAN
« on: February 06, 2006, 05:46 PM »
Hello,

This code is an FBSL one.
This will show you how to embedd a flash game into a GUI application :)

To compile this script into a real stand alone EXEcutable, i invite you to copy/paste this script there :
http://gedd123.free..../studio/fbsl2exe.php

'// ----------------------------------------
'// ATL control
'// Purpose : running a Flash GAME
'// Author  : Gerome GUILLEMIN
'// ----------------------------------------
Dim %oFlash, %hWnd

Sub Form_Load()
   Apicall( "AtlAxWinInit", "ATL" )
   Dim $WinName = "{D27CDB6E-AE6D-11CF-96B8-444553540000}"
   hWnd = FBSL_Control("AtlAxWin", Me, WinName, 0, 0, 15, 620, 460, WS_Child + WS_Visible, WS_Ex_ClientEdge)
   Apicall( "AtlAxGetControl", "ATL", hWnd, @oFlash )
   PutValue( oFlash, ".Movie=%s", "http://www.80smusiclyrics.com/games/pacman/pacman.swf" )
End Sub

Sub RefreshAfxControl()
Dim %Lefti, %Topi, %Righti, %Bottomi
   GetClientRect( Me, Lefti, Topi, Righti, Bottomi )
   ReSize(hWnd, 0, 30, Righti - 15, Bottomi - 60)
   Refresh(hWnd)
End Sub

Sub Main()
   Fbsl_SetText( Me, "PaC-man..." )
   Resize(Me, 0, 0, 640, 480 )
   Center(Me): Show(Me): Form_Load()
   RefreshAfxControl()
   Begin Events
      If CBMsg = WM_CLOSE Then
          ReleaseObject( oFlash ): ExitProgram(0)
      End If
      If CBMSG = WM_SIZE Then RefreshAfxControl()
   End Events
End Sub

Any comments ? :)
Enjoy ;)

Pages: prev1 [2]