Dedication check.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Dedication check.

Post by dodicat »

Windows 7 and above.
Takes a couple of minutes to search.

Code: Select all

 


'shell to include unicode
declare function wsystem cdecl alias "_wsystem" (byval as wstring ptr) as long
 #Include "file.bi"
function savefile(filename As String,p As String) as string
    Dim As long n=freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:sleep:end
    End If
    return filename
End function

Function loadfile(file as string) as String
	If FileExists(file)=0 Then Print file;" not found":Sleep:end
   var  f=freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
      text = String(Lof(f), 0)
      Get #f, , text
    End If
    Close #f
    return text
end Function

function pre_pend(filename As String,txt As String) as string
    Dim As String s=loadfile(filename)
    If Len(s) Then savefile(filename,txt+s)
    return filename
End function

function ap_pend(filename As String,txt As String) as string
    Dim As String s=loadfile(filename)
    If Len(s) Then savefile(filename,s+txt)
    return filename
End function

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then 
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function

dim as string f,g,msg
redim as string a()
dim as integer fb,k
print "please wait while searching for freebasic ..."
wsystem ("where /r c:\ fbc32.exe fbc64.exe fbc.exe > myfreebasics.txt")
f=loadfile("myfreebasics.txt")
stringsplit(f,chr(13,10),a())
fb=ubound(a)
print "please wait while searching for gcc ..."

wsystem ("where /r c:\  gcc.exe > myfreebasics.txt")
g=loadfile("myfreebasics.txt")

pre_pend( "myfreebasics.txt",f)

f=loadfile("myfreebasics.txt")

stringsplit(f,chr(13,10),a())

for n as long=lbound(a) to ubound(a)
    if n<=fb then msg="FreeBASIC" else msg="gcc"
    k=iif(n<=fb,n,n-fb)
    print msg + " installation  ";k
    dim as string f
    f=chr(34)+a(n)+chr(34)
    print f
    wsystem(f+"  --version")
    print "________________"
    print
    next

wsystem("pause")
kill "myfreebasics.txt"


 
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Dedication check.

Post by jj2007 »

dodication check failed miserably - but it seems to work with the full path for "where" (awfully slow, of course - it's still running):

Code: Select all

'shell to include unicode
declare function wsystem cdecl alias "_wsystem" (byval as wstring ptr) as long
 #Include "file.bi"
function savefile(filename As String,p As String) as string
    Dim As long n=freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:sleep:end
    End If
    return filename
End function

Function loadfile(file as string) as String
   If FileExists(file)=0 Then Print file;" not found":Sleep:end
   var  f=freefile
    Open file For Binary Access Read As #f
    Dim As String text
    If Lof(f) > 0 Then
      text = String(Lof(f), 0)
      Get #f, , text
    End If
    Close #f
    return text
end Function

function pre_pend(filename As String,txt As String) as string
    Dim As String s=loadfile(filename)
    If Len(s) Then savefile(filename,txt+s)
    return filename
End function

function ap_pend(filename As String,txt As String) as string
    Dim As String s=loadfile(filename)
    If Len(s) Then savefile(filename,s+txt)
    return filename
End function

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then 
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function

dim as string f,g,msg
redim as string a()
dim as integer fb,k
print "please wait while searching for freebasic ..."
wsystem ("C:\Windows\System32\WHERE.exe /r c:\ fbc32.exe fbc64.exe fbc.exe > myfreebasics.txt")
f=loadfile("myfreebasics.txt")
stringsplit(f,chr(13,10),a())
fb=ubound(a)
print "please wait while searching for gcc ..."

wsystem ("C:\Windows\System32\WHERE.exe /r c:\  gcc.exe > myfreebasics.txt")
g=loadfile("myfreebasics.txt")

pre_pend( "myfreebasics.txt",f)

f=loadfile("myfreebasics.txt")

stringsplit(f,chr(13,10),a())

for n as long=lbound(a) to ubound(a)
    if n<=fb then msg="FreeBASIC" else msg="gcc"
    k=iif(n<=fb,n,n-fb)
    print msg + " installation  ";k
    dim as string f
    f=chr(34)+a(n)+chr(34)
    print f
    wsystem(f+"  --version")
    print "________________"
    print
    next

wsystem("pause")
kill "myfreebasics.txt"
P.S.: After about 20 minutes, I get this:

Code: Select all

c:\Users\AllBasics\fbc.exe
c:\Users\AllBasics\fbc64.exe
c:\Users\AllBasics\Fb64\bin\fbc.exe
c:\Users\AllBasics\Members\Garmich\_fb\fbc.exe
c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\fbc32.exe
c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\fbc64.exe
c:\NoMinGW\bin\gcc.exe
c:\TDM-GCC-32\bin\gcc.exe
c:\TDM-GCC-64\bin\gcc.exe
c:\Users\AllBasics\\FPC\3.0.4\bin\i386-win32\gcc.exe
c:\Users\AllBasics\bin\win32\gcc.exe
c:\Users\AllBasics\bin\win32_old\gcc.exe
c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\bin\win32\gcc.exe
c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\bin\win64\gcc.exe
c:\Users\Jochen\VirtualBox VMs\JShared\Perl\c\bin\gcc.exe

please wait while searching for freebasic ...
please wait while searching for gcc ...
FreeBASIC installation   1
"c:\Users\AllBasics\fbc.exe"
FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win32 (32bit)
Copyright (C) 2004-2016 The FreeBASIC development team.
standalone
________________

FreeBASIC installation   2
"c:\Users\AllBasics\fbc64.exe"
FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win64 (64bit)
Copyright (C) 2004-2016 The FreeBASIC development team.
________________

FreeBASIC installation   3
"c:\Users\AllBasics\Fb64\bin\fbc.exe"
FreeBASIC Compiler - Version 1.05.0 (01-31-2016), built for win64 (64bit)
Copyright (C) 2004-2016 The FreeBASIC development team.
________________

FreeBASIC installation   4
"c:\Users\AllBasics\Members\Garmich\_fb\fbc.exe"
FreeBASIC Compiler - Version 0.90.1 (07-17-2013) for win32
Copyright (C) 2004-2013 The FreeBASIC development team.
standalone
________________

FreeBASIC installation   5
"c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\fbc32.exe"
FreeBASIC Compiler - Version 1.06.0 (09-03-2018), built for win32 (32bit)
Copyright (C) 2004-2016 The FreeBASIC development team.
standalone
________________

FreeBASIC installation   6
"c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\fbc64.exe"
FreeBASIC Compiler - Version 1.06.0 (09-03-2018), built for win64 (64bit)
Copyright (C) 2004-2016 The FreeBASIC development team.
standalone
________________

gcc installation   1
"c:\NoMinGW\bin\gcc.exe"
gcc.exe (GCC) 4.8.1
Copyright (C) 2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   2
"c:\TDM-GCC-32\bin\gcc.exe"
gcc.exe (tdm-1) 4.9.2
Copyright (C) 2014 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   3
"c:\TDM-GCC-64\bin\gcc.exe"
gcc.exe (tdm64-1) 4.9.2
Copyright (C) 2014 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   4
"c:\Users\AllBasics\\FPC\3.0.4\bin\i386-win32\gcc.exe"
2.95
________________

gcc installation   5
"c:\Users\AllBasics\bin\win32\gcc.exe"
gcc.exe (i686-win32-sjlj-rev0, Built by MinGW-W64 project) 8.1.0
Copyright (C) 2018 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   6
"c:\Users\AllBasics\bin\win32_old\gcc.exe"
gcc.exe (i686-win32-sjlj-rev2, Built by MinGW-W64 project) 4.9.2
Copyright (C) 2014 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   7
"c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\bin\win32\gcc.exe"
gcc.exe (i686-win32-sjlj-rev0, Built by MinGW-W64 project) 8.1.0
Copyright (C) 2018 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   8
"c:\Users\AllBasics\Members\WinFBE_Suite\FreeBASIC-1.06.0\bin\win64\gcc.exe"
gcc.exe (x86_64-win32-seh, Built by MinGW-W64 project) 4.8.2
Copyright (C) 2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

________________

gcc installation   9
"c:\Users\Jochen\VirtualBox VMs\JShared\Perl\c\bin\gcc.exe"
gcc.exe (i686-posix-sjlj, built by strawberryperl.com project) 4.8.3
Copyright (C) 2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Last edited by jj2007 on Jan 21, 2019 10:41, edited 2 times in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Dedication check.

Post by dodicat »

Thanks for testing jj2007.
It takes a couple of minutes to do a complete search here.
I assumed that where.exe was on the system path for all windows version 7 and above, but obviously not.
I have 24 gcc.exe here, from 2.94 to 6.3 which is over the top I would say, some will have to go.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Dedication check.

Post by jj2007 »

dodicat wrote:I have 24 gcc.exe here
For decades, I worked with exactly ONE GfaBasic installation. I had to abandon Gfa when M$ stopped supporting 16-bit applications. In contrast, Gcc is an ugly mess, and unfortunately some seem eager to turn FB into a Gcc clone.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Dedication check.

Post by dodicat »

Indeed jj2007, I hate gcc and I have 24 of the blighters, where did I go wrrong?
My 2.95 version seems to be in freepascal, according to marcov it is only a miserable skeleton of a thing required to handle a few puny tasks.
marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Re: Dedication check.

Post by marcov »

dodicat wrote: My 2.95 version seems to be in freepascal, according to marcov it is only a miserable skeleton of a thing required to handle a few puny tasks.
Yeah, it is a subset of what windres resource compiler needs for preprocessing headers, for when you want to distribute windres, but not the whole of gcc. (GAS target?) That's also why it is so old, it is not a regular build, so can't be updated easily.

But FPC can probably be easily disqualified by looking for other gcc related binaries in the same dir ?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Dedication check.

Post by dodicat »

jj2007
20 minutes seems long, you must have many files on your system.
I note that you have MinGW temporarily off path, ready to be re sprung into action when required.
marcov
I have recently joined the freepascal forum, under a nomdeploom of course.(Dutch word translation on the fly)
I have been coding some things (two posted to the forum).
Now I am putting semi-colons at the end of freebasic statements.
I am toying with posting a freebasic gfx dll with a little demo somewhere, in graphics I suppose.
I have it nearly done, it runs well.
I have not made a unit but perhaps
{$include gfx.inc}
where the dll calls are made in the .inc file which is in the same folder as the .exe.

But I am straying off topic (with a new cutting edge moderator)
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Dedication check.

Post by Tourist Trap »

dodicat wrote:Windows 7 and above.
Takes a couple of minutes to search.
Takes more than 2 minutes, but it worked for me. I have 2 installation of FB, and 4 of GCC. That's quite what I knew. But my system is recent so it's not too much a mess - for the moment...
I dont find where the myfreebasics.txt file has been created ...
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Dedication check.

Post by dodicat »

My gcc's all tell me:

This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

I would have said DON'T LOOK A GIFT HORSE IN THE MOUTH, or something equally as subtle, and not degraded my work to NOT FIT FOR PURPOSE.
Thanks for testing TT.
Post Reply