Purebasic always the best.

[CONVERT]

Hello,
I work in an American group. A factory in France needed a script in an ERP ( Enterprise Resource Planning ) for displaying several files about production orders. The normal language is still VBS in this group. So, I wrote it with VBS. As there are about 10 000 files to scan on a server, the response time was about 40 seconds, rather uncomfortable for the technical and SAV teams using it. So, I rewrote it in Purebasic (ExamineDirectory with "*" in its pattern). See here the testimony of the local IT support in this plant:

Hello Jean
Excellent, it works perfectly!
It is faster, and not slightly faster, as we change a response time of 40 seconds to a immediate response!

Salut Jean,
Excellent, ça fonctionne parfaitement!
C'est plus rapide, et pas qu'un peu, puisque l'on passe d'un temps d'ouverture d'environ 40 secondes à une ouverture instantanée!

[majikeyric]

PB rulez !

[Shield]

I'd be interested in having a look at that script and what functions you used.

[Dude]

Good stuff!

[CONVERT]

Hello Shield,

I'll show you the VBS code and the PB code on Monday. It's at the office...

It's very little and simple. In PB, there are about 100 active lines.

In VBS, there is no wildcard character like "*", so it must compare a part of the name of every file.

In PB, there is the ExamineDirectory instruction with a pattern like "something*.*". It seems it's more efficient, even through a local network.

[Dude]

Now, ask them for a pay rise.

[firace]

Hello Shield,

I'll show you the VBS code and the PB code on Monday. It's at the office...

As much as we would like to see it, do make sure that you're legally allowed to do that.

Well done on your achievement!

[Kwai chang caine]

Cool to can use PB in professionnal world
Me too, i use it since several years in my enterprise, for replace VBA OLE, to remote an emulator of IBM3270
Thanks to the giant COMATE of SROD, it's really fast

PB is great, and again, your client don't know the power of the familly community of PB ...

[CONVERT]

The "fast" PB code.

Not sure I am allowed to show that, but I am interested by any comment, to improve me...

First, the .ini file:

Code: Select all

DIR01 = C:\Test\Serie1
DIR02 = C:\Test\Serie2
DIR03 = C:\Test\Serie3
of_nb_maxi = 2

Second, the PB code:

Code: Select all

EnableExplicit

; Scans some directories in which there are fabrication orders nnnnnn_bbb.suf, where
; nnnnnn is the fabrication order
; bbb    is the benchmark number
; suf    is the suffix of the file (.txt, .xls, etc.).

; when these files are found, there are displayed alltogether, 
; finding the right application To open them.

; If found in one directory, it's sure they are not in another directory.
; There is a limited number of benchmark number. It's sure there will not have other one outside a List (001 002 003 at the beginning).

Global GTitre$, GTitre_commercial$

Gtitre$ = GetFilePart(ProgramFilename())
Gtitre$ = Left(GTitre$,Len(GTitre$) - 4)  ; enlever le .exe
GTitre_commercial$ = "erp_fo_display"

; -----------------------------------------------------  mutex
IncludePath "..\Common"
XIncludeFile "Mutex_inc.pb"

Procedure mes(Plib$)
  MessageRequester(GTitre$,Plib$)  
EndProcedure

If mutex_create(GTitre_commercial$) = 0
  mes(GTitre_commercial$ + " déjà en exécution")
  End
EndIf

; ----------------------------------------------------- Global variables main

Global Gfini$ = GetCurrentDirectory () + GTitre_commercial$ + ".ini"

Global Gfo_nb_to_be_found$

; ----------------------------------------------------- Global variables ini file

#ini_dir$ = "DIR"  ; followed by nn from 01 to 99. No discontinuity.
#ini_fo_nb_maxi$ = "of_nb_maxi"

Global NewList GL_dir$()
Global Gfo_nb_maxi.i

; -----------------------------------------------------

Procedure lect_ini ()
  Define wcpt.i, wcpt$, wdir$
  
  If FileSize(Gfini$) < 0
    mes(Gfini$ + " absent.")
  EndIf
  
  OpenPreferences(Gfini$)  
  wcpt = 1
  Repeat
    wcpt$ = Str(wcpt)
    If Len(wcpt$) = 1
      wcpt$ = "0" + wcpt$
    EndIf
    wdir$ = ReadPreferenceString(#ini_dir$ + wcpt$,"")
    If wdir$ <> ""
      AddElement(GL_dir$())
      GL_dir$() = wdir$
    Else
      Break
    EndIf
    wcpt + 1
  ForEver
  
  If ListSize(GL_dir$()) = 0
    mes("Manque paramètre DIRnn= dans " + Gfini$ + ", nn allant de 0 à 99 sans trou.")
    End
  EndIf
  
  Gfo_nb_maxi = ReadPreferenceInteger(#ini_fo_nb_maxi$,0)
  
  If Gfo_nb_maxi = 0
    mes("Manque paramètre " + #ini_fo_nb_maxi$ + "= dans " + Gfini$)
    End
  EndIf
    
  ClosePreferences()
  
EndProcedure

Procedure accept_parameter ()
  
  If CountProgramParameters() = 0
    mes("Manque numéro d'ordre de fabrication comme paramètre.")
    End
  EndIf
  
  Gfo_nb_to_be_found$ = ProgramParameter()

EndProcedure

Procedure display_file(Pdir$,Pfile$)
  RunProgram(pdir$ + "\" + Pfile$)
EndProcedure

Procedure.i fo_nb_found_in_one_directory (Pdir$)
  
  Define wno_dir.i, wnb_file_found.i
  
  If FileSize(Pdir$) <> -2
    ProcedureReturn 0
  EndIf
  
  wno_dir = ExamineDirectory(#PB_Any,Pdir$,Gfo_nb_to_be_found$ + "*.*")
  
  If wno_dir = 0
    ProcedureReturn 0
  EndIf
  
  wnb_file_found = 0
  
  While NextDirectoryEntry(wno_dir)
    If DirectoryEntryType(wno_dir) = #PB_DirectoryEntry_File 
      display_file(Pdir$,DirectoryEntryName(wno_dir))
      wnb_file_found + 1
    EndIf
  Wend
  
  FinishDirectory(wno_dir)
  
  ProcedureReturn wnb_file_found
  
EndProcedure

Procedure.i scan_directories ()
  Define wscan_dir.i
  
  ResetList(GL_dir$())
  
  While NextElement(GL_dir$())
    wscan_dir = fo_nb_found_in_one_directory (GL_dir$())
    If wscan_dir <> 0
      Break
    EndIf
  Wend
  
  ProcedureReturn wscan_dir
  
EndProcedure

;- BEGIN

lect_ini ()

accept_parameter ()

If scan_directories() = 0
  mes("Aucun ordre de fabrication trouvé.")
EndIf

End

Mutex_inc.pb code in include (not important) :

Code: Select all

Procedure.i Mutex_create(Pmutex_name$)
  Define wmutex.i
  wmutex = CreateMutex_(0,1,Pmutex_name$)
  If GetLastError_()=#ERROR_ALREADY_EXISTS
    wmutex = 0
  EndIf
  ProcedureReturn wmutex
EndProcedure

Procedure Mutex_release(Pmutex.i)
  ReleaseMutex_(Pmutex)
EndProcedure

It's run by the following .bat when the user clicks on a button in the ERP:

Code: Select all

erp_fo_display_V002.exe 4567

where 4567 is the beginning of the fabrication order to be found.

[CONVERT]

And the slow VBS code (40 seconds against 1 or 2 seconds of the PB version):

Code: Select all

Option Explicit

' Scans some directories in which there are fabrication orders nnnnnn_bbb.suf, where
' nnnnnn is the fabrication order
' bbb    is the benchmark number
' suf    is the suffix of the file (.txt, .xls, etc.).

' when these files are found, there are displayed alltogether, using the shellexecute
' finding the right application to open them.

' If found in one directory, it's sure they are not in another directory.
' There is a limited number of benchmark number. It's sure there will not have other one outside a list (001 002 003 at the beginning).


'----------------------------------------------  rerun under 64 bit environment if possible
runAs64

' -------------------------------------------------------------------- PARAMETERS

' ------------------------------------------------ Directories

Dim Gt_dir (2) ' nb of directories minus 1  (2 for 3 directories)
Gt_dir(0) = "C:\Test\Serie1"        ' without ending anti-slash
Gt_dir(1) = "C:\Test\Serie2"	 ' without ending anti-slash
Gt_dir(2) = "C:\Test\Serie3"	 ' without ending anti-slash

Dim Gt_dir_nb_maxi
Gt_dir_nb_maxi = UBound(Gt_dir)

' ------------------------------------------------ Fabrication sub_number. How many?
Dim Gt_fonb_nb_maxi
Gt_fonb_nb_maxi = 2

' ------------------------------------------------------------------- Script name
Dim Gtitre, Gtitre_script, Gtitre_racine

Gtitre_script = WScript.ScriptName
Gtitre = Left(Gtitre_script,Len(Gtitre_script)-4)     ' to remove .VBS
Gtitre_racine = Left(Gtitre,Len(Gtitre)-3)            ' to remove nnn of version

' ------------------------------------------------------------------ Librairies
Dim GoFso
Set Gofso 		= CreateObject("Scripting.FileSystemObject")

Dim GoShell
Set GoShell      = CreateObject("Wscript.Shell")

' =======================================================================
' =======================================================================  BEGIN
' =======================================================================

Dim wfo_nb_to_be_found

wfo_nb_to_be_found = accept_parameter ()

If wfo_nb_to_be_found = "" Then
	WScript.Echo "Erreur : le paramètre 'n° Ordre fabrication' est vide."
	WScript.Quit
End If

If scan_directories (wfo_nb_to_be_found) = 0 Then
	WScript.Echo "Aucun ordre de fabrication trouvé."
End If

WScript.Quit

' =======================================================================
' =======================================================================  SUBROUTINES
' =======================================================================

Function accept_parameter ()
	accept_parameter = ""
	If WScript.Arguments.Count > 0 Then
		accept_parameter = WScript.Arguments.Item(0)
	End If
End Function

Function scan_directories (Pfo_nb_to_be_found)
	Dim wi
	
	scan_directories = 0
	
	For wi = 0 To Gt_dir_nb_maxi
		If fo_nb_found_in_one_directory (Pfo_nb_to_be_found, Gt_dir(wi)) Then
			scan_directories = 1
			Exit For
		End If
	Next
End Function

Function fo_nb_found_in_one_directory (Pfo_nb_to_be_found,Pdir)
	Dim wfolder, wfile, wfile_l, wfile_to_be_found, wfile_to_be_found_len
	
	fo_nb_found_in_one_directory = 0
	
	If GoFso.FolderExists(Pdir) = False Then
		Exit Function
	End If
	
	wfile_to_be_found     = LCase(Pfo_nb_to_be_found)
	wfile_to_be_found_len = Len(wfile_to_be_found)
	
	Set wfolder = GoFSO.getfolder(Pdir)

	For Each wFile in wfolder.Files
		wfile_l = LCase(GoFso.GetFileName(wfile.name))
				
		If Left(wfile_l,wfile_to_be_found_len) = wfile_to_be_found Then
			display_file wfile.Path
			fo_nb_found_in_one_directory = fo_nb_found_in_one_directory + 1
			If fo_nb_found_in_one_directory >= Gt_fonb_nb_maxi Then
				Exit For
			End If
		End If
	Next
	
End Function

Function display_file (Pfile)
	GoShell.Run (Chr(34) & Pfile & Chr(34))
End Function


'IncludePath ..\..\..\Common

'XIncludeFile runas64_inc_v001.vbs
Sub runAs64()
	Dim oWS : Set oWS = WScript.CreateObject("WScript.Shell")
	dim arch : arch = oWS.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PROCESSOR_ARCHITECTURE")
	if (arch = "AMD64" and InStr(LCase(WScript.Path), "syswow64")>0) then
		dim cmdLine
		if (InStr(LCase(WScript.FullName), "wscript.exe") > 0) then
			cmdLine = "%SystemRoot%\Sysnative\wscript.exe """ & WScript.ScriptFullName & """"
		elseif (InStr(LCase(WScript.FullName), "cscript.exe") > 0) then
			cmdLine = "%SystemRoot%\Sysnative\cscript.exe """ & WScript.ScriptFullName & """"
		else
			wscript.quit(-1)
		end if

		dim arg
		for each arg in wscript.arguments
			cmdLine = cmdLine & " " & arg
		next

		dim oExec : set oExec = oWS.Exec(cmdLine)

		Do While oExec.Status = 0
			WScript.Sleep 1000
		Loop

		dim output : output = oExec.StdOut.Readall()
		if (len(output) >= 2) then
			wscript.echo mid(output, 1, len(output) - 1)
		end if
		
		wscript.quit(oExec.ExitCode)
	end if
End Sub

It's run by the following .bat when the user clicks on a button in the ERP:

Code: Select all

wscript.exe erp_fo_display_V002.vbs 4567

where 4567 is the beginning of the fabrication order to be found.