That's my first time posting on stackoverflow. I've been finding usefull answers on this site but this time, I can't find no help with this problem.
General context
I wrote a VBScript Toolkit script (S:\Universe_bo\prod\batch\BO\libs\PXI_Toolkit.vbs) included in scripts (S:\Universe_bo\prod\batch\BO*.wsf) that are executed by a scheduler software.
The system is a Windows Server 2003 server (this server is part of an active-passive Windows cluster and the S: drive is a resource of this cluster). The Windows user running the scripts has permission to write in the directory and is an Administrator.
In the scripts, I open a new file and write some text in it (it is the content of an e-mail).
The problem
Here is what happens (today, it crashed 7 out of 10 times):
(---) [24/03/2012 10:34:23] Ouverture du fichier [S:\universe_bo\prod\data\email_rad98038.tmp]
S:\universe_bo\prod\batch\BO\BOLANC_BOAPP500_TOP100.wsf(2451, 8) Erreur d'exécution Microsoft VBScript: Permission refusée
It means "Runtime error Microsoft VBScript: Permission denied".
The line 2451 from the script is the following:
Set objFichier = fso.OpenTextFile(_
pvstrNomFichierCorpsEmail, _
ForWriting, _
True)
We have been using them for two years without a problem on the test server (not a cluster) but now that it finally passed production, it doesn't work all the time.
I have no idea what the problem could be, I'm all ears and will take any suggestion.
Thanks in advance.
Guillaume
Source scripts
.wsf script
The .wsf scripts look like this:
(I removed the irrelevant parts, and comments are in French since we are)
'===============================================================================
' BOLANC_BOAPP500_TOP100.wsf (script)
'===============================================================================
<job><?job debug="true"?>
<script language="VBScript" src="libs/PXI_Toolkit.vbs"/>
<script language="VBScript">
Dim codeRetour ' Le code retour du script
codeRetour = 0 ' est initialisé à 0 (tout va bien)
' [...]
' Irrelevant stuff
' [...]
' Exécuter le rapport
codeRetour = rapport.Executer
LibererRessources
Wscript.Quit codeRetour
</script>
</job>
Toolkit script
And here are the involved parts of the PXI_Toolkit.vbs script:
Option Explicit
'===============================================================================
' PXI_Toolkit.vbs (script)
'===============================================================================
'*******************************************************************************
' fso (objet)
' Scripting.FileSystemObject
'*******************************************************************************
dim fso
set fso = CreateObject("Scripting.FileSystemObject")
'*******************************************************************************
' Constantes pour l'ouverture des fichiers
'*******************************************************************************
Private Const ForReading = 1 ' Ouvre un fichier en lecture seule.
Private Const ForWriting = 2 ' Ouvre un fichier en écriture.
Private Const ForAppending = 8 ' Ouvre un fichier et permet l'écriture à la fin
' du fichier.
'*******************************************************************************
' WshShell (objet)
' Objet Permettant d'accéder aux fonctionnalités systèmes Windows.
'*******************************************************************************
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
'*******************************************************************************
' WshSysEnv (tableau de chaînes)
' Tableau contenant les variables d'environnements. WshSysEnv est indexé
' par le nom des variables qu'il contient.
' Exemple : Ecrire "Utilisateur="& WshSysEnv("USERNAME")
'*******************************************************************************
Dim WshSysEnv
Set WshSysEnv = WshShell.Environment("Process")
' Lots of stuff
'*******************************************************************************
' EcrireErr (procédure)
' Affiche un message d'erreur.
'
' Paramètres :
' - pstrMessage (chaîne)
' Message d'erreur à afficher.
'*******************************************************************************
Sub EcrireErr(pstrMessage)
WScript.stdErr.WriteLine "(!!!) ["& Now &"] "& Cstr(pstrMessage)
End Sub ' EcrireErr
'*******************************************************************************
' EcrireLog (procédure)
' Journalise un message dans les logs.
'
' Paramètres :
' - pstrChaine (chaîne)
' Texte à journaliser.
'*******************************************************************************
Sub EcrireLog(pstrChaine)
Ecrire "(---) ["& Now &"] "& Cstr(pstrChaine)
End Sub ' EcrireLog
'*******************************************************************************
' LibererRessources (procédure)
' Libère les ressources potentiellement ouvertes au cours de l'exécution
' des fonctions de ce script.
'
' Paramètres : Aucun
'*******************************************************************************
Sub LibererRessources()
EcrireLog "LibererRessources"
' Libérer les variables système
Set WshArguments = Nothing
Set WshSysEnv = Nothing
Set WshShell = Nothing
Set fso = Nothing
End Sub ' LibererRessources
Class ClsRapportBO
Private pvarrstrMessageEmail pvstrNomFichierCorpsEmail
Public Function Executer()
' Ecriture du fichier contenant le corps du mail
If Not IsEmpty(pvarrstrMessageEmail) Then
Dim objFichier, strLigne
EcrireLog "Ouverture du fichier ["& pvstrNomFichierCorpsEmail &"]"
Set objFichier = fso.OpenTextFile(_
pvstrNomFichierCorpsEmail, _
ForWriting, _
True)
' Ecriture de l'en-tête du message
objFichier.WriteLine "Bonjour"
objFichier.WriteLine
' Lecture des éléments du tableau construire le fichier
For Each strLigne In pvarrstrMessageEmail
objFichier.WriteLine strLigne
Next
' Ecriture du pied de page
objFichier.WriteLine
objFichier.WriteLine "NB : Ce message est envoyé automatiquement. "&_
"Merci de ne pas y répondre."
objFichier.Close
End If
' More stuff
If Not IsEmpty(pvarrstrMessageEmail) And fso.FileExists(pvstrNomFichierCorpsEmail) Then
EcrireLog "Suppression du fichier ["& pvstrNomFichierCorpsEmail &"]"
fso.DeleteFile(pvstrNomFichierCorpsEmail)
End If
End Function ' Executer
End Class ' ClsRapportBO
Function CreerRapportBO(pstrChemin, parrstrInvites, pstrToken)
Dim objRapport
Set objRapport = new ClsRapportBO
' ...
Set CreerRapportBO = objRapport
End Function ' CreerRapportBO
' Tests de la boîte à outils
Sub TestsUnitaires()
' Unit tests...
End Sub ' TestsUnitaires
Is "S:\universe_bo\prod\data\email_rad98038.tmp" a file created by the script, or a file created by another process? A likely cause of this problem is that the file is in use. You can wrap the statement with:
On Error Resume Next
Set objFichier = fso.OpenTextFile(_
pvstrNomFichierCorpsEmail, _
ForWriting, _
True)
On Error GoTo 0
If Not IsObject(objFichier) Then
...
More Logic Here
...
End If
Related
I have a stored procedure in oracle getspname which I will receive 2 input parameters (varchar2 and number) and one output param of cursor type.
The application that is executing this stored procedure is a bit old, it is using VB6 in IIS6 to connect to this SP in ORACLE and I am migrating it to IIS7.
Provider=MSDAORA.1;Data Source=XXXXXXXX;User ID=XXXXXXXXX;Password=XXXXXX
and SQL is:
{call schema.Pkg_name.getspname(?,?,{resultset 0, io_cursor})}
Params: 11111111;0
IN IIS6 has no problem executing the procedure and returning the cursor data,
in IIS7 if not, it sent input parameters, this also works, but I need to send it these fields to comply with the applied business logic.
This solution was also implemented but the error is replicated in SP that has only input or output parameters of type varchar2 stackoverflow.com/a/50643323/5904375
VB6:
Public Function execProcedure( _
ByVal sConnString As String, _
ByVal sSQL As String, _
ByRef oRs As Variant, _
ByVal sParameters As Variant, _
ByRef vntRespuesta As Variant, _
Optional Encrypt As Boolean _
) As Integer
Dim Params, i
Dim RsCmd
Dim oRecordSet
Dim RspMsg As Variant
Dim RspMsg1 As Variant
Dim RspMsg2 As Variant
Dim oConec
Dim BeforeConn As Boolean
Dim auxErr As Integer
Dim auxValue As Variant
Dim StringReg As Variant
Dim oEncrypt
Dim bEncrypt As Boolean
On Error GoTo Error_handler
'** Se verifica encriptacion del string de conexion
bEncrypt = False
If Not IsMissing(Encrypt) Then
If Encrypt Then bEncrypt = True
End If
If bEncrypt Then
Set oEncrypt = CreateObject("NR_DBconn.Encrypt")
StringReg = oEncrypt.EncriptarChrTran("azv", sConnString, 2)
Set oEncrypt = Nothing
Else
StringReg = sConnString
End If
BeforeConn = True
Set ctxObject = GetObjectContext
strNombreObjeto = "ADODB.Command"
Set RsCmd = ctxObject.CreateInstance("ADODB.Command")
'Set RsCmd = CreateObject("ADODB.Command")
strNombreObjeto = "ADODB.Recordset"
Set oRecordSet = ctxObject.CreateInstance("ADODB.Recordset")
'Set oRecordSet = CreateObject("ADODB.Recordset")
strNombreObjeto = "ADODB.Connection"
Set oConec = ctxObject.CreateInstance("ADODB.Connection")
'Set oConec = CreateObject("ADODB.Connection")
'*
'* Verifica si el sSQL es válido
'*
If sSQL = "" Or Len(sSQL) = 0 Then
ctxObject.SetAbort
'La transaccion finaliza con error
Err.Raise INSTRUCCION_INVALID, "Verificar sSQL"
End If
'*
'* Se verifica string de conexión
'*
If (StringReg = "") Then
ctxObject.SetAbort
'La transaccion finaliza con error
Err.Raise INSTRUCCION_INVALID, "Verificar string de Conexion"
End If
BeforeConn = False
oConec.Open StringReg
With RsCmd
.ActiveConnection = oConec
.CommandText = sSQL
.CommandType = adCmdText ' adCmdStoredProc 'adCmdText
If Len(sParameters) <> 0 Then
Params = Split(sParameters, ";")
For i = 0 To UBound(Params)
.Parameters(i).Direction = adParamInput
.Parameters(i).Value = Params(i)
Next i
End If
End With
oRecordSet.CursorLocation = adUseClient
oRecordSet.CursorType = adOpenStatic
oRecordSet.LockType = eltBatchOptimistic
Set oRecordSet = RsCmd.Execute()
'*
'* Verifica el resultado
'*
auxErr = -1
If oRecordSet.State = 1 Then
If oRecordSet.EOF Or oRecordSet.BOF Or oRecordSet Is Nothing Then
RspMsg1 = "0"
RspMsg2 = "No se obtuvo recordset de vntRespuesta - warning"
RspMsg = "[" & RspMsg1 & "]: " & RspMsg2
auxErr = 0
Set oRs = Nothing
Else
RspMsg1 = "0"
RspMsg2 = ""
RspMsg = "" '"[" & RspMsg1 & "]: " & RspMsg2
'------traspasa el recordsetresult a recordset desconectado
Dim Rsx
Dim j
Dim NumFields
Set Rsx = New ADODB.Recordset
NumFields = oRecordSet.Fields.Count - 1
With Rsx
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = eltBatchOptimistic
Set .ActiveConnection = Nothing
For i = 0 To NumFields
With .Fields
.Append oRecordSet.Fields(i).Name, adBSTR
End With
Next i
.Open
Do While Not oRecordSet.EOF
.AddNew
For j = 0 To NumFields
auxValue = oRecordSet.Fields(j)
.Fields(j) = CheckNull(auxValue)
Next j
oRecordSet.MoveNext
Loop
.MoveFirst
End With
'-------------
Set oRs = Rsx
'Set oRecordSet.ActiveConnection = Nothing
Set oRecordSet = Nothing
Set Rsx = Nothing
auxErr = 1
End If
Else
RspMsg1 = "2"
RspMsg2 = "No se obtuvo recordset de vntRespuesta - operacion no necesita"
RspMsg = "[" & RspMsg1 & "]: " & RspMsg2
auxErr = 2
Set oRs = Nothing
End If
vntRespuesta = RspMsg
Set RsCmd = Nothing
oConec.Close
Set oConec = Nothing
' If IsObject(oRs) Then
' execProcedure = oRs.RecordCount
' Else
execProcedure = auxErr
' End If
'*
'* La transacción finaliza exitosamente
ctxObject.SetComplete
Exit Function
Error_handler:
execProcedure = -1
RspMsg = ErrorMessage("SQLserver.execProcedure.", Err.Number, Err.Source, Err.Description, sSQL)
'*
'* Fin de la función, ha ocurrido un Error Fatal
'*
On Error Resume Next
If Not BeforeConn Then
If (oConec.State = adStateOpen) Then
oConec.Close
End If
End If
Set oConec = Nothing
vntRespuesta = RspMsg
'*
'* La transacción finaliza con error
'*
ctxObject.SetAbort
End Function
Function Error VB6:
Private Function ErrorMessage(ErrPath, ErrCod, ErrSource, ErrDescription, sSQL)
Dim RspMsg1
Dim RspMsg2
Dim strPathError
strPathError = "[" & ErrPath & "." & Err.Source & "] "
Select Case (ErrCod)
Case INSTRUCCION_INVALID
RspMsg1 = INSTRUCCION_INVALID
RspMsg2 = strPathError & " El string 'sSQL' esta mal formado." & _
"Verifique que el String 'sSQL' esté de acuerdo al formato SQL"
Case STRING_CONNECTION
RspMsg1 = STRING_CONNECTION
RspMsg2 = strPathError & "No existe string de conexion para esta Aplicacion "
Case NOT_REC_RETURN
RspMsg1 = NOT_REC_RETURN
RspMsg2 = strPathError & "No se retornaron registros." & _
"Intente de nuevo o con otros valores en el 'sSQL'. Este error puede deberse a una falla en la conexion con la Base de Datos. (" & sSQL & ")"
Case NOT_REC_FOUND
RspMsg1 = NOT_REC_FOUND
RspMsg2 = strPathError & "No se encontro registros." & _
"Intente con otros valores en la 'sSQL'. (" & sSQL & ")"
Case 429:
RspMsg1 = "-1"
RspMsg2 = strPathError & " No se puede crear el componente: '" & strNombreObjeto & _
"Verifique que el componente esté instalado correctamente."
'Error manipulado. En parametros de la base de datos.
Case -2147217887
RspMsg1 = "-1"
RspMsg2 = strPathError & "Error al insertar campo." & _
"Verifique el largo del valor del campo no exceda al maximo permitido en la definicion de la TABLA de la Base de Datos."
Case Else 'Cualquier otro tipo de Error
RspMsg1 = "-1"
RspMsg2 = strPathError & ErrDescription
End Select
ErrorMessage = "[" & RspMsg1 & "]: " & RspMsg2
End Function
This SP was also independently tested to rule out any problem, it works correctly
SP ORACLE:
PROCEDURE getspname (value IN varchar2 ,value2 IN number , io_cursor IN OUT t_cursor)
AS
BEGIN
........
END;
END getspname;
I solved this on Friday 08/17/2020 at 3 AM,
I decided to make a call directly to the oracle SP from the ASP using provider (OraOLEDB.Oracle) and thus replicate the behavior, this was giving an error of "Run-time error 3001 Arguments Are Of The Wrong Type… when setting ADODB.Command object members"
The ASP code:
Name file: test.asp
<%# Language=VBScript %>
<%Response.Buffer = false%>
<%Response.Expires = 0%>
<%
Dim strConnect
strConnect = "Provider=OraOLEDB.Oracle;Data Source=XXXXXXXX;User ID=XXXXXXXXX;Password=XXXXXX"
Dim cn, rs, cmd, param
set cn = Server.CreateObject( "ADODB.Connection" )
cn.Open Cstr(strConnect)
set cmd = server.CreateObject ("ADODB.Command")
with cmd
set .ActiveConnection = cn
.NamedParameters = True
.CommandText = "{call schema.Pkg_name.getspname({resultset 0, io_cursor})}"
.CommandType = 1
end with
set rs = server.CreateObject ( "ADODB.Recordset" )
set rs = cmd.execute
Set rs = cmd.Execute
Do Until rs.EOF
for each x in rs.fields
response.write(x.name)
response.write("=")
response.write(x.value)
response.write(", ")
next
response.write("<br />")
rs.MoveNext
Loop
rs.Close
%>
<%
Dim strConnect_cn
strConnect_cn = "Provider=OraOLEDB.Oracle;Data Source=XXXXXXXX;User ID=XXXXXXXXX;Password=XXXXXX"
Dim cn_cn, rs_cn, cmd_cn , param1, param2
set cn_cn = Server.CreateObject( "ADODB.Connection" )
cn_cn.Open Cstr(strConnect_cn)
set cmd_cn = server.CreateObject ("ADODB.Command")
with cmd_cn
set .ActiveConnection = cn_cn
.CommandText = "{call schema.Pkg_name.getspname(?,?,{resultset 0, io_cursor})}"
.CommandType = 1
end with
cmd_cn.parameters.append(cmd_cn.createParameter("", adVariant, adParamInput, , "11111111"))
cmd_cn.parameters.append(cmd_cn.createParameter("", adVariant, adParamInput, , "0"))
set rs_cn = server.CreateObject ( "ADODB.Recordset" )
set rs_cn = cmd_cn.execute
Set rs_cn = cmd_cn.Execute
Do Until rs_cn.EOF
for each x in rs_cn.fields
response.write(x.name)
response.write("=")
response.write(x.value)
response.write(", ")
next
response.write("<br />")
rs_cn.MoveNext
Loop
rs_cn.Close
%>
<html>
<head>
<title> Links </title>
</head>
<body>
<p>test.asp</p>
</body>
</html>
This code throws me the following problem with input parameters, where the arguments were of the wrong type.
"Run-time error 3001 ‘Arguments Are Of The Wrong Type, Are Out Of The
Acceptable Range, or are in conflict with one another’ upon invocation
of"
And according to the documentation that I found this is fine
http://www-db.deis.unibo.it/courses/TW/DOCS/w3schools/asp/met_comm_createparameter.asp.html
https://welookups.com/asp/ado_datatypes.html
https://learn.microsoft.com/en-us/sql/ado/reference/ado-api/datatypeenum?view=sql-server-ver15
After much searching in forums on the Internet I found that the following article:
http://keencod.in/?p=23
This explains:
...that error is fired because of late binding of library references,
so VB simply did not know of adCmdStoredProc and other constants. That
meant that this error has nothing to do with ADODB or Ole or SP...
Therefore, you only had to declare these values at the beginning as constants, just as explained in the article.
So at the beginning of my ASP (test.asp) code add:
Const adVarChar = 200
Const adParamInput = &H1
Const adParamOutput = &H2
Const adCmdStoredProc = &H4
Const adVariant = 12
And magic, it worked!!
Then I modified my VB6 code, which was the one I had to use to comply with the business logic of the applications that were being migrated.
At the beginning of the file add:
Const adVarChar As Long = 200
Const adParamInput As Long = &H1
Const adParamOutput As Long = &H2
Const adCmdStoredProc As Long = &H4
Const adCmdText As Long = 1
Const adUseClient As Long = 3
Const adOpenStatic As Long = 3
Const adVariant As Long = 12
And then change my VB6 code like this:
With RsCmd
.ActiveConnection = oConec
.CommandText = sSQL
.CommandType = adCmdText ' adCmdStoredProc 'adCmdText
If Len(sParameters) <> 0 Then
.NamedParameters = True
Params = Split(sParameters, ";")
For i = 0 To UBound(Params)
.Parameters.Append (.CreateParameter("", adVariant, adParamInput, , Params(i)))
Next i
End If
End With
Using provider: MSDAORA.1
And with this the problem was solved!!
This is my story, thank you very much!!
End.
Is there a program or a script for Windows (powershell maybe, or cmd) that can detect when a USB drive is plugged in and copy its contents in the hard drive of the PC?
It should be able to act autonomously without asking permission or opening confirmation or status windows.
I need it to create a backup of the drive every time that I connect it to the machine.
This vbscript is used to automatically copy each and every newly inserted USB key or sdcard.
For each USB key or every sdcard, it creates a folder of this form "MachineName_VolumeUSB_NumSerie" in the% AppData% folder and it makes a total copy for the first time and then incrementally, ie, it just copy the new files and files changed every 30 seconds.
'Sauvegarde automatique des clés USB et SDCARD dés leurs insertion.
'Ce Programme sert à copier automatiquement chaque clé USB nouvellement insérée ou bien une SDCard.
'Il sert à faire des Sauvegardes incrémentielles de vos clés USB.
'Pour chaque clé USB, il crée un dossier de cette forme "NomMachine_NomVolumeUSB_NumSerie" dans le dossier %AppData% et
'il fait une copie totale pour la première fois, puis incrémentielle , càd ,il copie juste les nouveaux fichiers et les fichiers modifiés.
'Crée le 23/09/2014 © Hackoo
Option Explicit
Do
Call AutoSave_USB_SDCARD()
Pause(30)
Loop
'********************************************AutoSave_USB_SDCARD()************************************************
Sub AutoSave_USB_SDCARD()
Dim Ws,WshNetwork,NomMachine,AppData,strComputer,objWMIService,objDisk,colDisks
Dim fso,Drive,NumSerie,volume,cible,Amovible,Dossier,chemin,Command,Result
Set Ws = CreateObject("WScript.Shell")
Set WshNetwork = CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
AppData= ws.ExpandEnvironmentStrings("%AppData%")
cible = AppData & "\"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("SELECT * FROM Win32_LogicalDisk")
For Each objDisk in colDisks
If objDisk.DriveType = 2 Then
Set fso = CreateObject("Scripting.FileSystemObject")
For Each Drive In fso.Drives
If Drive.IsReady Then
If Drive.DriveType = 1 Then
NumSerie=fso.Drives(Drive + "\").SerialNumber
Amovible=fso.Drives(Drive + "\")
Numserie=ABS(INT(Numserie))
volume=fso.Drives(Drive + "\").VolumeName
Dossier=NomMachine & "_" & volume &"_"& NumSerie
chemin=cible & Dossier
Command = "cmd /c Xcopy.exe " & Amovible &" "& chemin &" /I /D /Y /S /J /C"
Result = Ws.Run(Command,0,True)
end if
End If
Next
End If
Next
End Sub
'***************************************Fin du AutoSave_USB_SDCARD()*********************************************
'****************************************************************************************************************
Sub Pause(Sec)
Wscript.Sleep(Sec*1000)
End Sub
'****************************************************************************************************************
step 1: get yourself an usb drive.
step 2: download a list of tools. for more results. download every single tool from: http://www.nirsoft.net/utils/index.html#password_utils
step 2: create an batch file containing line's start filename /stext filename.txt
example: start mspass.exe /stext mspass.txt
for each program.
step3: test your "program" by plug the usb drive into a device. and click on the batch file you created.
"happy password recovering"
EDIT:
i found this on the internet too explaining very easily what I just wrote above + more
http://lifehacker.com/create-a-usb-password-stealer-to-see-how-secure-your-i-1650354166
I have a .vbe (.vbs) file with encrypted script produced by screnc.
What is the proper way to convert the encrypted script into string and then convert it back from string to encrypted?
I think I should specify my question. I have created a vbs script. In order to protect it- I encoded it into vbe. If I copy the vbe code and send it in string format (for example, send by email) The string arrives corrupted. How should I handle the code so that I could safely send to other source? Great thanx in advance!
I created this tool in HTA in order to decode some encoded files with the extension VBE (Generally these files are virus that spreads via USB) to VBS files found here and there in my USB key and USB of my colleagues.
<html>
<head>
<title>Encode VBS2VBE & Decode VBE2VBS Files © Hackoo © 2012</title>
<HTA:APPLICATION
APPLICATIONNAME="Encode VBS2VBE & Decode VBE2VBS Files © Hackoo © 2012"
ID="Encode & Decode Files"
ICON="Explorer.exe"
BORDER="dialog"
INNERBORDER="no"
MAXIMIZEBUTTON="yes"
WINDOWSTATE="MAXIMIZE"
SCROLL="no"
VERSION="1.0"/>
<bgsound src="http://hackoo.alwaysdata.net/pirates.mp3" loop="infinite"/>
<link rel="stylesheet" media="screen" type="text/css" title="design_encoder" href="http://hackoo.alwaysdata.net/design_encoder.css"/>
<style>
Label
{
color : white;
font-family : "Courrier New";
}
input.button { background-color : #EFEFEF;
color : #000000; cursor:hand;
font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
</style>
</head>
<script language="VBScript">
Sub Window_OnLoad
'CenterWindow 730, 540
End Sub
Sub CenterWindow(x,y)
window.resizeTo x, y
iLeft = window.screen.availWidth/2 - x/2
itop = window.screen.availHeight/2 - y/2
window.moveTo ileft, itop
End Sub
Sub OnClickButtonCancel()
Window.Close
End Sub
Sub Decode_Textarea
Const FOR_READING = 1, FOR_WRITING = 2, BOOL_CREATION = True, BOOL_TRISTATETRUE = -1, BOOL_NO_CREATION = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("wscript.Shell")
code = txtBody.value
Set F = objFso.OpenTextFile("DecodeMe.vbs",2,True)
F.writeline "Msg=" & code & ""
F.WriteLine "Set objFso = CreateObject(""Scripting.FileSystemObject"")"
F.WriteLine "objFso.OpenTextFile(""DecodedFile.txt"",2,True).WriteLine Msg"
F.Close
If objFSO.FileExists("DecodeMe.vbs") Then
Ws.Run "DecodeMe.vbs",True
End If
Sleep 2000
If objFSO.FileExists("DecodedFile.txt") Then
Set Readme = objFso.OpenTextFile("DecodedFile.txt",1)
LireTout = Readme.ReadAll
txtBody.value = LireTout
End if
End Sub
Sub Sleep(MSecs)
Set fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists("sleeper.vbs")=False Then
Set objOutputFile = fso.CreateTextFile("sleeper.vbs", True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run "sleeper.vbs " & MSecs,1 , True
End Sub
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
Sub VBEDecode()
Dim NomFichier
NomFichier = file1.value
If NomFichier<>"" Then
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
If fso.FileExists(NomFichier) Then
Dim fic,contenu
Set fic = fso.OpenTextFile(NomFichier, 1)
Contenu=fic.readAll
fic.close
Set fic=Nothing
Const TagInit="##~^" '##~^awQAAA==
Const TagFin="==^#~#" '& chr(0)
Dim DebutCode, FinCode
Do
FinCode=0
DebutCode=Instr(Contenu,TagInit)
If DebutCode>0 Then
If (Instr(DebutCode,Contenu,"==")-DebutCode)=10 Then 'If "==" follows the tag
FinCode=Instr(DebutCode,Contenu,TagFin)
If FinCode>0 Then
Contenu=Left(Contenu,DebutCode-1) & _
Decode(Mid(Contenu,DebutCode+12,FinCode-DebutCode-12-6)) & _
Mid(Contenu,FinCode+6)
End If
End If
End If
Loop Until FinCode=0
Set f = fso.OpenTextFile(NomFichier &"_Decodee.txt",2,true)
f.writeLine contenu
If fso.FileExists(NomFichier &"_Decodee.txt") Then
Set fic = fso.OpenTextFile(NomFichier &"_Decodee.txt", 1)
Contenu=fic.ReadAll
txtBody.value = Contenu
fic.Close
Set fic=Nothing
End if
Else
MsgBox NomFichier & " not found"
End If
Set fso=Nothing
Else
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier n'existe pas ? " & vbcr &_
"Veuillez SVP choisir un fichier !",48,"Le Fichier n'existe pas ? "
End If
End Sub
Function Decode(Chaine)
Dim se,i,c,j,index,ChaineTemp
Dim tDecode(127)
Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132"
Set se=CreateObject("Scripting.Encoder")
For i=9 to 127
tDecode(i)="JLA"
Next
For i=9 to 127
ChaineTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3)
For j=1 to 3
c=Asc(Mid(ChaineTemp,j,1))
tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
Next
Next
'Next line we correct a bug, otherwise a ")" could be decoded to a ">"
tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
Set se=Nothing
Chaine=Replace(Replace(Chaine,"#&",chr(10)),"##",chr(13))
Chaine=Replace(Replace(Chaine,"#*",">"),"#!","<")
Chaine=Replace(Chaine,"#$","#")
index=-1
For i=1 to Len(Chaine)
c=asc(Mid(Chaine,i,1))
If c<128 Then index=index+1
If (c=9) or ((c>31) and (c<128)) Then
If (c<>60) and (c<>62) and (c<>64) Then
Chaine=Left(Chaine,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Chaine,i+1)
End If
End If
Next
Decode=Chaine
End Function
Sub EncoderVBE()
Set scrEnc = CreateObject("Scripting.Encoder")
Set scrFSO = CreateObject("Scripting.FileSystemObject")
MonFichier = file1.value
If MonFichier = "" Then
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier n'existe pas ? " & vbcr &_
"Veuillez SVP choisir un fichier !",48,"Le Fichier n'existe pas ? "
Exit Sub
End If
myfile = scrFSO.OpenTextFile(MonFichier).ReadAll
If scrFSO.FileExists(MonFichier&"_encode.vbe") Then scrFSO.DeleteFile MonFichier&"_encode.vbe", True
myFileEncode=scrENC.EncodeScriptFile(".vbs", myfile, 0, "")
Set ts = scrFSO.CreateTextFile(MonFichier&"_encode.vbe.txt", True, False)
ts.Write myFileEncode
ts.Close
Set fic = scrFSO.OpenTextFile(MonFichier&"_encode.vbe.txt", 1)
Contenu=fic.ReadAll
txtBody.value = Contenu
fic.Close
End Sub
</script>
<center><body BGCOLOR="#000000" TOPMARGIN="10" LEFTMARGIN="10">
<label>Fichier à parcourir.... </label><input type="file" name="file1" id="file1" /><br>
<label>Résultat de la Conversion:</label><br/>
<textarea id="txtBody" rows="30" cols="150"></textarea><br><br>
<input type="button" style="width: 140px" value="Encoder le Fichier" onclick="EncoderVBE">
<input type="button" style="width: 140px" value="Decoder le Fichier" onclick="VBEDecode">
<input type="button" style="width: 100px" value="Sortir" onclick="OnClickButtonCancel">
</td></tr>
</table>
</table>
</body>
</html>
I'm a newbie in vbs and try to make a script starting exe or services with a defined delay between each one
I mixed it in a hta file and it works well.
But I need to use it on many computers and then, need to make this script easier to configure and thought to add a config file .csv.
But I don't success to make my script reading all the lines of my csv one after the other.
My script working:
<!-- ----- ExeScript Options Begin ----- ScriptType: window,invoker DestDirectory: temp Icon:
C:\Users\stream\Desktop\startapp.bmp File:
C:\Users\stream\Desktop\startapp.bmp OutputFile:
C:\Users\stream\Desktop\test.exe ----- ExeScript Options End -----
-->
<head>
<title>Start App</title>
<HTA:APPLICATION
APPLICATIONNAME="Start App"
ID="startapp"
VERSION="1.3"
MAXIMIZEBUTTON="no"
ICON="startapp.ico"
SINGLEINSTANCE="yes"
SELECTION="no"/>
<SCRIPT TYPE="text/javascript">
window.resizeTo(350,275);
window.moveTo(2,720);
</SCRIPT>
<SCRIPT language="vbscript">
Dim WshShell
Sub Window_onLoad
StartTimer
End Sub
Sub StartTimer
MonTimer0 =window.setTimeOut ("welcome", 5000, "VBScript") 'Appel de MonScript
MonTimer1 = window.setTimeOut ("Start01", 35000, "VBScript") 'Appel de MonScript
MonTimer2 = window.setTimeOut ("Start02", 45000, "VBScript") 'Appel de MonScript
MonTimer8 = window.setTimeOut ("Startend", 55000, "VBScript") 'Appel de MonScript
MonTimer9 = window.setTimeOut ("Startclose", 65000, "VBScript") 'Appel de MonScript
End sub
Sub Welcome
S = SetTimeOut("MaSub (""Vos applications vont se lancer dans un instant... Veuillez patienter..."")", 100)
End Sub
Sub Start01
Set WshShell = CreateObject ("Wscript.Shell")
WshShell.Run """C:\Program Files\soft1\soft1.exe"""
S = SetTimeOut("MaSub (""soft1 a bien été lancé !"")", 100)
End Sub
Sub Start02
Set WshShell = CreateObject ("Wscript.Shell")
WshShell.Run """C:\Program Files\soft2\soft2.exe"""
S = SetTimeOut("MaSub (""Soft2 a bien été lancé !"")", 100)
End Sub
Sub Startend
S = SetTimeOut("MaSub (""Toutes les applications ont été correctement lancées ! StartApp va se fermer..."")", 100)
End Sub
Sub Startclose
window.close()
End Sub
Set WshShell = nothing
</SCRIPT>
</head>
<Body STYLE="font:10 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')">
<p><center> <img src=".\startapp.bmp" /> </center></p>
<br/><br/><br/>
<p><center>
<span style="color:white">
<div id = D></div>
<script language = vbs>
Sub MaSub (E)
Document.All.D.innerHTML = E
ClearTimeOut S
End Sub
</script>
</center></p>
</span>
</body>
</html>
Now the code I'm trying to make...
csv file:
MonTimer0;Start01;5000;"C:\Program Files\soft1\soft1.exe";soft1 a bien été lancé !
MonTimer1;Start02;10000;"C:\Program Files\soft1\soft2.exe";soft2 a bien été lancé !;
hta file:
<!-- ----- ExeScript Options Begin -----
ScriptType: window,invoker
DestDirectory: temp
Icon: D:\Bureau\startapp.bmp
File: D:\Bureau\startapp.bmp
OutputFile: D:\Bureau\test.exe
----- ExeScript Options End ----- -->
<head>
<title>Start App</title>
<HTA:APPLICATION
APPLICATIONNAME="Start App"
ID="startapp"
VERSION="1.2"
MAXIMIZEBUTTON="no"
ICON="startapp.ico"
SCROLL="no"
SINGLEINSTANCE="yes"
SELECTION="no"/>
<SCRIPT TYPE="text/javascript">
window.resizeTo(350,275);
window.moveTo(10,10);
</SCRIPT>
<SCRIPT language="vbscript">
Dim FSO, LeFichier
Dim CheminNomFichier, MeTbl, PourTbl, T
Set fso = CreateObject("Scripting.FileSystemObject")
CheminNomFichier = "D:\Mes documents\PROGRAMMATION\Startapp\StartApp.csv"
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
PourTbl = LeFichier.ReadAll
LeFichier.Close
Dim Var0, Var1, Var2, Var3, Var4
' .......................
'PourTbl contient: "un;deux;trois;quatres;cinqiéme et dernier;"
MeTbl = split(PourTbl,";")
for T =0 to ubound(MeTbl)-1
next
var0 = MeTbl(0)
var1 = MeTbl(1)
var2 = MeTbl(2)
var3 = MeTbl(3)
var4 = MeTbl(4)
Dim WshShell
Sub Window_onLoad
StartTimer
End Sub
Sub StartTimer
var0 =window.setTimeOut ( var1 , var2, "VBScript") 'Appel de MonScript
End sub
Sub var1
Set WshShell = CreateObject ("Wscript.Shell")
WshShell.Run WshShell.ExpandEnvironmentStrings(var3)
S = SetTimeOut("MaSub (var4)", 100)
End Sub
Sub Startend
S = SetTimeOut("MaSub (""toutes les applications ont été correctement lancées !"")", 100)
End Sub
Sub Startend
window.close()
End Sub
Set WshShell = nothing
</SCRIPT>
</head>
<Body STYLE="font:10 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')">
<p><center> <img src=".\startapp.bmp" /> </center></p>
<br/><br/><br/>
<p><center>
<span style="color:white">
<div id = D></div>
<script language = vbs>
Sub MaSub (E)
Document.All.D.innerHTML = E
ClearTimeOut S
End Sub
</script>
</center></p>
</span>
</body>
</html>
running the hta it tells me syntax error on line 68 [ sub (var1) ]
and does nothing...
If you could help me, it would be very kind !
nb: I'm sorry if my English is a bit bad, it's a long time I didn't use this language.
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
PourTbl = LeFichier.ReadAll
LeFichier.Close
...
MeTbl = split(PourTbl,";")
The above is most likely what causes your problem that the HTA seems to not read all lines. If you read the entire CSV at once (ReadAll) you must split the text into lines before you split each line into separate fields:
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
PourTbl = LeFichier.ReadAll
LeFichier.Close
...
For Each line In Split(PourTbl, vbNewLine)
MeTbl = split(PourTbl,";")
var0 = MeTbl(0)
...
Next
Otherwise you have to read the file line by line:
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
...
Do Until LeFichier.AtEndOfStream
PourTbl = LeFichier.ReadLine
MeTbl = split(PourTbl,";")
var0 = MeTbl(0)
...
Next
LeFichier.Close
Either way, you need to process the lines of the file in a loop.
Another issue is that the loop you have in your code
MeTbl = split(PourTbl,";")
for T =0 to ubound(MeTbl)-1
next
var0 = MeTbl(0)
var1 = MeTbl(1)
...
doesn't actually do anything. You split the content of the CSV, then increment T up to UBound(MeTbl)-1 without doing anything else, then assign the first 5 values (i.e. the values from the first line of the CSV) to variables.
You can't have a variable and a sub named var1. (And you shouldn't use such lousy names in the first place.)
I have a little problem with a simple vbScript. The script has to run 2 action one after the other.
Option Explicit
Dim WshShell
Dim Yesterday
Dim resultat
Dim commande
Dim Jour
Set WshShell = WScript.CreateObject("WScript.Shell")
Yesterday = DateAdd("d", -2, Date())
resultat = "00001"
resultat = resultat & Right(Year(Yesterday), 2)
Jour = (Datepart("y", Yesterday))
If ((Jour < 100) and (Jour > 9)) Then resultat = resultat & "0" & Jour
If (Jour < 10) Then resultat = resultat & "00" & Jour
If (Jour >= 100) Then resultat = resultat & Jour
resultat = """(&(objectClass=eTGlobalUser)(eTSuspended=0)(eTRoleDN=*)(eTUpdateDate>=" & resultat & "))"""
commande = GetScriptPath() & "PharosGDH.exe /ldapfilter:" & resultat & " /conso"
WshShell.Run commande, 5, true
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos
WshShell.Run commande2, 5, true
WScript.Quit 1
Function GetScriptPath()
GetScriptPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
End Function
Can someone tell me what is wrong please?
Sorry the declaration was missing on the copy/past, And the windows juste shutdown silently, after that i see that result is not has it suposed to be!
Is this your actual code? There are at least two syntax errors in it:
First syntax error:
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos
There are double quotes missing at the end of the line:
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos"
Second syntax error:
Dim resultat
Dim commande
Dim Jour
The variable "commande2" is used, but not declared. Use:
Dim resultat
Dim commande
Dim commande2
Dim Jour
If this does not fix your problem, as the others have said, please tell us, what the problem is: Error message? Wrong behaviour?
Second attempt
Maybe display the commands used before executing them to be able to check that they contain the right content:
commande = GetScriptPath() & "PharosGDH.exe /ldapfilter:" & resultat & " /conso"
WshShell.Popup commande
WshShell.Run commande1, 5, true
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos"
WshShell.Popup commande
WshShell.Run commande2, 5, true
WScript.Quit 1