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 - euklides

Pages: [1]
1
Programs / Selecting a folder (a little vbs function)
« on: April 10, 2022, 10:54:15 am »
Little function to select a folder with VBS
(win systems)
Code: QB64: [Select]
  1. MYREP$ = REPSELECTOR$("D:"): Print MYREP$
  2. MYREP$ = REPSELECTOR$(""): Print MYREP$: Sleep
  3.  
  4. Function REPSELECTOR$ (repertoiredemarrage$)
  5.     Repz$ = repertoiredemarrage$:  FS2$ = Chr$(13) + Chr$(10)
  6.     fs1$ = "Dim objFolder, objItem, objShell" + FS2$
  7.     fs1$ = fs1$ + "On Error Resume Next" + FS2$
  8.     fs1$ = fs1$ + "SelectFolder = vbNull" + FS2$
  9.     fs1$ = fs1$ + "myStartFolder = " + "²" + Repz$ + "²" + FS2$
  10.     fs1$ = fs1$ + "Set objShell  = CreateObject( ²Shell.Application² )" + FS2$
  11.     fs1$ = fs1$ + "Set objFolder = objShell.BrowseForFolder( 0, ²Select Folder², 0, myStartFolder )" + FS2$
  12.     fs1$ = fs1$ + "If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path" + FS2$
  13.     fs1$ = fs1$ + "Set WshShell = WScript.CreateObject(²WScript.Shell²)" + FS2$
  14.     fs1$ = fs1$ + "WshShell.Run ²cmd.exe /c echo ² & SelectFolder & ² | clip², 0, TRUE   " + FS2$
  15.     FS5: J = InStr(fs1$, "²"): If J > 0 Then Mid$(fs1$, J, 1) = Chr$(34): GoTo FS5
  16.     ficvbs$ = _CWD$ + "\TEMP_FS.vbs": CanalLibre% = FreeFile: Open ficvbs$ For Output As CanalLibre%
  17.     Print #1, fs1$: Close CanalLibre%: _Delay 0.1:
  18.     Shell ficvbs$: Kill ficvbs$
  19.     REPSELECTOR$ = _Clipboard$
  20.  

2
QB64 Discussion / ZIP and UNZIP (windows only) solution
« on: January 02, 2022, 04:45:10 am »
ZIP & UNZIP  (Windows)
Generally, you can use for instance 7-zip to zip or unzip files (via Shell command)
(program C:\Program Files (x86)\7-Zip\7z.exe  or C:\Program Files\7-Zip\7z.exe)

But here we use PowerShell included in Windows.
Same samples of possible situations.
Of course you need to use your own file names and directories.

'---1--- ZIPPING A SINGLE FILE
ZIPTOCREATE$ = "D:\TEMP\TESTMAKING.ZIP"
MYFILE$ = "D:\CZUR\SV0010_Janvier_1914.pdf"
UU$ = "powershell Compress-Archive -force -path " + Chr$(34) MYFILE$+ Chr$(34) + " " + Chr$(34) + ZIPTOCREATE$ + Chr$(34)
Shell UU$
'Note     -force overwrite existing ZIP.  You can use -update to refresh the ZIP
End

'---2--- ZIPPING MULTIPLE FILES
ZIPTOCREATE$ = "D:\TEMP\TESTMAKING.ZIP"
FILE1$ = "D:\CZUR\SV0010_Janvier_1914.pdf"
FILE2$ = "D:\CZUR\SV0011_Février_1914.pdf"
UU$ = "powershell Compress-Archive -force -path " + Chr$(34) + FILE1$ + Chr$(34) + " ,  " + Chr$(34) + FILE2$ + Chr$(34) + " " + Chr$(34) + ZIPTOCREATE$ + Chr$(34)
Shell UU$
End

---3--- ZIPPING MULTIPLE FILES with ' * '
ZIPTOCREATE$ = "D:\TEMP\TESTMAKING.ZIP"
FILEZ$ = "D:\CZUR\*.pdf" : ' We want here to zip all pdf file located in CZUR directory
UU$ = "powershell Compress-Archive -force -path " + Chr$(34) + FILEZ$ + Chr$(34) + " " + Chr$(34) + ZIPTOCREATE$ + Chr$(34)
Shell UU$
End

'---4--- ZIPPING A DIRECTORY WITH THE ROOT 
REPERTOIREACOPIER$ = "D:\CZUR\MYFILES"  '  (don't add \ at the end of the path)
ZIPTOCREATE$ = "D:\TEMP\TESTMAKING.ZIP"
UU$ = "powershell Compress-Archive -force " + Chr$(34) + REPERTOIREACOPIER$ + Chr$(34) + " " + Chr$(34) + ZIPTOCREATE$ + Chr$(34)
Shell UU$
end

'---5--- ZIPPING A DIRECTORY WITHOUT THE ROOT 
REPERTOIREACOPIER$ = "D:\CZUR\MYFILES\*"    '  ( add \*  at the end of the path)
ZIPTOCREATE$ = "D:\TEMP\TESTMAKING.ZIP"
UU$ = "powershell Compress-Archive -force " + Chr$(34) + REPERTOIREACOPIER$ + Chr$(34) + " " + Chr$(34) + ZIPTOCREATE$ + Chr$(34)
Shell UU$
'Note: the zip file created has not information about "myfiles" directory
end

'---6---UNZIPPING 

DESTINATIONDIRECTORY$ = "D:\CZUR\tempo"   
ZIPTOUNZIP$ = "D:\CZUR\livre.ZIP"
UU$ = "powershell Expand-Archive -force " + Chr$(34) + ZIPTOUNZIP$ + Chr$(34) + " " + Chr$(34) + DESTINATIONDIRECTORY$ + Chr$(34)
Shell UU$
' if TEMPO directory do not exist, it will be created (due to -force option)
End

Please read  for more informations:
'https://docs.microsoft.com/en-us/powershell/module/microsoft.powershell.archive/compress-archive?view=powershell-7.2
'https://docs.microsoft.com/en-us/powershell/module/microsoft.powershell.archive/expand-archive?view=powershell-7.2





3
Programs / FUNCTION FOR OPEN or SELECT A FILE (Windows)
« on: May 05, 2021, 08:04:27 am »
Here a little function for select or open a file...

FIRST USE: select one file (getting his name and directory)

myfile$ = FILESELECTOR$("")
IF myfile$ = "" THEN PRINT "No file choosen" ELSE PRINT "Your choice is" + CHR$(13) + myfile$
SLEEP
END


SECOND USE
select a file and open it !
myfile$ = FILESELECTOR$("OPEN")
The file you select will be opened with the current windows application :
'XLS file--> Excel, DOC--> Word, PDF-->Acrobat JPG-->Picture program... aso

Hope usefull...



Code: QB64: [Select]
  1. FUNCTION FILESELECTOR$ (FS$) '  FS$ = "" select 1 file // FS$ ="OPEN"--> open the file with it's current windows application
  2.     _CLIPBOARD$ = "": FS2$ = CHR$(13) + CHR$(10): FS3$ = "echo": IF UCASE$(FS$) = "OPEN" THEN FS3$ = ""
  3.     FS1$ = "Set wShell = CreateObject(²WScript.Shell²)" + FS2$
  4.     FS1$ = FS1$ + "Set oExec = wShell.Exec(²mshta.exe ²²about:<input type=file "
  5.     FS1$ = FS1$ + "id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')."
  6.     FS1$ = FS1$ + "GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>²²²)" + FS2$
  7.     FS1$ = FS1$ + "sFileSelected = oExec.StdOut.ReadLine" + FS2$
  8.     FS1$ = FS1$ + "Set WshShell = WScript.CreateObject(²WScript.Shell²)" + FS2$
  9.     FS1$ = FS1$ + "WshShell.Run ²cmd.exe /c " + FS3$ + " ² & sFileSelected & ² | clip², 0, TRUE" + CHR$(13)
  10.     FS1$ = FS1$ + "set Wshell=nothing" + FS2$ + "set WshShell=nothing" + FS2$:
  11.     FS4: J = INSTR(FS1$, "²"): IF J > 0 THEN MID$(FS1$, J, 1) = CHR$(34): GOTO FS4
  12.     ficvbs$ = _CWD$ + "TEMP_FS.vbs": CanalLibre% = FREEFILE: OPEN ficvbs$ FOR OUTPUT AS CanalLibre%
  13.     PRINT #1, FS1$: CLOSE CanalLibre%: _DELAY 0.1: SHELL _HIDE "cscript  //NoLogo " + ficvbs$: _DELAY .5: KILL ficvbs$
  14.     IF INSTR(_CLIPBOARD$, " ECHO ") > 0 THEN _CLIPBOARD$ = ""
  15.     FILESELECTOR$ = _CLIPBOARD$
  16.  
  17.  

4
QB64 Discussion / About "Opening files"
« on: May 02, 2021, 10:39:14 am »

Please see:
https://www.qb64.org/forum/index.php?topic=2689.msg119268#top  (locked)

Well, the program given by bplus works fine, but you can select only ONE file.

Is there a way to select directly multiple files (located  in a directory, of course) ?


5
QB64 Discussion / about Converting .pdf to plain text
« on: April 30, 2021, 04:36:47 am »
Please seehttps://www.qb64.org/forum/index.php?topic=3357.0   (locked subjet)

Here in France, we are receiving more and more computerized till receipts in pdf/txt format. No paper: ecology and saving trees...

I find the little program from Richard to convert pdf to plain text very useful to convert these little tickets into a txt format and archive them easily.

By the way: for serial processing with multiple pdf, you can close the current pdf at screen with the command "_SCREENPRINT CHR$(23) " and go so to the next pdf


6
QB64 Discussion / QB about...
« on: November 26, 2020, 10:27:57 am »
Hello,
Why "about" in the QB program do'nt say if you are working with a 32 bits or a 64 bits version of QB ?
Thank's

- QB64 64 bits says:
QB64 Version 1.4
Revision Release Candidate
From git of 6990118

- QB64 32 bits says:
QB64 Version 1.4
Stable Release
From git of 0f49b2c

7
QB64 Discussion / QB64 win-x86 or win-x64
« on: November 26, 2020, 04:10:17 am »

When I use QB64, how do I know if I am using version win-x86 or version win-x64?
The 'about' menu seems not to be enough clear.

I have both versions of QB64, because I create some programs in both 32 and 64 bits.
And when I have a program created with QB64, how do I know if it's 32 or 64 bit if I haven't been careful when creating it ...

Thank's

8
Programs / Re: Moon Phase Display
« on: March 29, 2020, 12:19:57 pm »
Note: This message is awaiting approval by a moderator.
Nice...

Cycle = 29.53059

Usefull for werewolves and vampires, of course !!!  :)

9
QB64 Discussion / zoom on picture
« on: December 18, 2019, 05:00:16 am »
In your opinion, is there a way to zoom (to display an enlarged area) on a part of an picture ?
Thank you for your ideas on this subject.


10
Programs / Easter date...
« on: August 03, 2019, 03:45:02 am »
When you work on the calendar, it may be useful to know the date of Easter ...
This little program gives you the date of Easter Day.


Code: Text: [Select]
  1. Question: INPUT "Year you want to know the day of Easter"; Q$: IF Q$ = "" THEN END
  2. PQA = VAL(Q$): IF PQA < 1582 THEN BEEP: GOTO Question
  3. GOSUB PAQUES
  4. PRINT "Easter date ---> month : "; PQM; "  day : "; PQJ; "  year: "; PQA: GOTO Question
  5.  
  6. PAQUES: PQM = INT(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = INT(((PQA / 19 - INT(PQA / 19)) + .001) * 19)
  7. PQ2 = INT(PQM / 4): PQ3 = INT(((PQM / 4) - PQ2 + .001) * 4): PQ4 = INT((8 + PQM) / 25)
  8. PQ5 = INT((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - INT(PQ4)
  9. PQ4 = INT(PQ4 * 30): PQ5 = INT(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
  10. PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - INT(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
  11. PQ6 = INT(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = INT(PQ2): PQJ = INT((PQ2 - PQM + .001) * 31 + 1)
  12. RETURN
  13.  

11
Programs / Working with files located on USB devices
« on: July 12, 2019, 05:09:44 am »
When you write a program using files located on USB drives, you don't
'be sure that the letter of this drive is always the same.
So you can use this little program



Code: QB64: [Select]
  1.  
  2. 'LETTER_OF_USB_DEVICE  'program by Euklides
  3. 'Working with files on USB devices
  4.  
  5. 'When you write a program using files located on USB drives, you don't be
  6. 'sure that the letter of this drive is always the same.
  7. 'You cannot write for instance:
  8.  
  9. '         OPEN "F:\MYFILE\info.txt" FOR INPUT AS #1
  10. '         ...
  11.  
  12. 'If your drive has a new letter, for instance "E", you must go into your program
  13. ' and change the letter
  14. 'So what you can do is this:
  15.  
  16. '1) '  find the serial of your drive
  17. '  Use below:
  18.  
  19. '         GOSUB SERIALSSHOW
  20.  
  21. '  and you will see all the serials of then actuel connected drives
  22. '  For instance, the good drive has the serial "<9911-447E>
  23.  
  24. '2) Now write your program so:
  25.  
  26. '        fic$ = "<9911-447E>:\MYFILE\info.txt"
  27. '        GOSUB DRIVELETTERFIND: IF _CLIPBOARD$ = "" THEN PRINT "USB unit is not connected for using " + fic$: END
  28. '        fic$ = _CLIPBOARD$:OPEN fic$ FOR INPUT AS #1
  29. '       ...
  30.  
  31.  
  32.  
  33.  
  34. '=====================================================================
  35. FUNCTION GetVolumeInformationA& (lpRootPathName$, lpVolumeNameBuffer$, BYVAL nVolumeNameSize~&, _
  36.     lpVolumeSerialNumber~&, lpMaximumComponentLength~&, lpFileSystemFlags~&, lpFileSystemNameBuffer$, BYVAL nFileSystemNameSize&)
  37. DECLARE LIBRARY: FUNCTION GetDriveType& (d$): END DECLARE
  38. DIM SHARED DriveType AS STRING, SERIALFOUND AS STRING
  39. '---
  40. SERIALSSHOW:
  41. FOR q = 1 TO 26: X = GetFileInfo(q): IF SERIALFOUND <> "<!!!-!!!>" THEN PRINT " "; CHR$(64 + q) + ":    "; SERIALFOUND
  42. '---
  43. DRIVELETTERFIND: 'in-->fic$ like' "<SER-IAL>ficname"  out--> like "D:\ficname"
  44. _CLIPBOARD$ = "": K$ = UCASE$(LEFT$(fic$, 2))
  45. IF RIGHT$(K$, 1) = ":" AND LEFT$(K$, 1) >= "A" AND LEFT$(K$, 1) <= "Z" AND DRIVEEXISTS(ASC(K$) - 64) = 1 THEN _CLIPBOARD$ = fic$: RETURN
  46. J1 = INSTR(fic$, "<"): J2 = INSTR(J1, fic$, ">")
  47. IF J1 = 0 OR J2 = 0 THEN PRINT fic$; " must be written like: <serial>\ficmame...": END
  48. Serialsearch$ = MID$(fic$, J1, J2 - J1 + 1): q = 0
  49. FOR q = 1 TO 26: X = GetFileInfo(q)
  50.     IF SERIALFOUND = Serialsearch$ THEN
  51.         fic$ = RIGHT$(fic$, LEN(fic$) - J2): IF LEFT$(fic$, 1) <> ":" THEN fic$ = ":" + fic$
  52.         fic$ = CHR$(64 + q) + fic$: _CLIPBOARD$ = fic$
  53.     END IF
  54. '---
  55. FUNCTION GetFileInfo (D)
  56.     SERIALFOUND = "<!!!-!!!>":
  57.     IF DRIVEEXISTS(D) <> 1 THEN GetFileInfo = 0: EXIT FUNCTION
  58.     Dname$ = CHR$(D + 64) + ":\": Sname$ = SPACE$(260)
  59.     R = GetVolumeInformationA(Dname$ + CHR$(0), Vname$, 260, serial~&, empty1~&, empty2~&, Sname$, 260)
  60.     IF R = 0 THEN EXIT FUNCTION
  61.     Sname$ = LEFT$(HEX$(serial~&), 4) + "-" + RIGHT$(HEX$(serial~&), 4)
  62.     SERIALFOUND = "<" + Sname$ + ">"
  63.     GetFileInfo = -1
  64. '---
  65. FUNCTION DRIVEEXISTS (V)
  66.     DRIVEEXISTS = 0: varX$ = CHR$(V + 64) + ":\" + CHR$(0): VarX = GetDriveType(varX$): IF VarX > 1 THEN DRIVEEXISTS = 1
  67. '=====================================================================
  68.  
  69.  

12
Programs / Re: opening urls in chrome browser
« on: June 21, 2019, 05:38:50 am »
Note: This message is awaiting approval by a moderator.
Why copying chrome into the working folder ????

Find the real folder of Chrome !

Exemple (with opera and firefox):

url$ = "
"

'Starting with opera:
prog$ = "C:\Program Files\Opera\launcher.exe"
SHELL _HIDE CHR$(34) + prog$ + CHR$(34) + " " + CHR$(34) + url$ + CHR$(34)



'starting with firefox:
prog$ = "C:\Program Files (x86)\Mozilla Firefox\firefox.exe"
SHELL _HIDE CHR$(34) + prog$ + CHR$(34) + " " + CHR$(34) + url$ + CHR$(34)


13
InForm Discussion / Multi-lines Textbox ?
« on: December 20, 2018, 04:53:37 am »


Is it possible to have a multi-line text box ?
And there is no word wrap for the textbox ...

Is inserting chr$(10) to have a new line in the same textbox a good idea, for instance ?

With VBA (Excel, word) there is no problem to this, and I wonder it is not possible with Inform.

This is a hindrance for me to use Inform.






Pages: [1]