PureBasic Forums - English

Code: Select all

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

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

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

Code: Select all

erp_fo_display_V002.exe 4567

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

Code: Select all

wscript.exe erp_fo_display_V002.vbs 4567