Creato da developer.web il 14/03/2014
Web Developer
|
Chi puņ scrivere sul blog
Solo l'autore puņ pubblicare messaggi in questo Blog e tutti gli utenti registrati possono pubblicare commenti.
Area personale
- Login
Menu
I miei link preferiti
Cerca in questo Blog
Tag
' ElencanteVBS v 3.0 Set oggetti = WScript.Arguments Dim conta, inizio, serie, pois, a, z, msg conta = oggetti.Count If conta = 0 Then MsgBox "Devi trascinare qui, col mouse, i files da rinominare!",0,"Uso sbagliato" WScript.Quit ElseIf conta = 1 Then MsgBox "Richiesto un numero minimo di 2 files selezionati per procedere!",0,"Uso sbagliato" WScript.Quit End If inizio = InputBox("Indicare il numero di partenza:", "Selezionati " & conta & " files", 1) If inizio = false Then MsgBox "Operazione deliberatamente annullata!",0,"Operazione annullata!" WScript.Quit End If If IsNumeric(inizio) = false Then MsgBox "Era richiesto un valore numerico positivo.",0,"Operazione annullata!" WScript.Quit Else If inizio < 0 Then MsgBox "Era richiesto un valore numerico positivo.",0,"Operazione annullata!" WScript.Quit End If End If serie = (inizio - 1) + conta pois = Len("S" & serie) - 1 a = Mid("S" & ((10 ^ pois) + inizio), 3) z = Mid("S" & ((10 ^ pois) + serie), 3) msg = InputBox("Inserire il nome ricorsivo dei files:" & VbCrlf & VbCrlf & "( il valore $ verra' sostituito dalla cifra crescente )", "Lista Files dalla cifra '" & a & "' alla cifra '" & z & "'", "NomeFile$.*") If msg = false Then MsgBox "Operazione deliberatamente annullata!",0,"Operazione annullata!" WScript.Quit End If If InStr(msg, "$") = 0 Then MsgBox "Era richiesto il simbolo $ come punto di inserzione del valore numerico crescente.",0,"Operazione annullata!" WScript.Quit End If Dim n, d, e, p, c, u, cartella, exo, ext, Fso d = InStrRev(msg, ".") u = Mid(msg, d+1) e = Mid(msg, 1, d-1) Set Fso = WScript.CreateObject("Scripting.FileSystemObject") For I = 0 to conta - 1 c = InStrRev(oggetti(I), "") cartella = Mid(oggetti(I), 1, c) p = InStrRev(oggetti(I), ".") exo = Mid(oggetti(I), p+1) ext = u If u = "*" Then ext = exo If u = "-" Then ext = LCase(exo) If u = "+" Then ext = UCase(exo) n = Mid("S" & ((10 ^ pois) + inizio + I), 3) Fso.MoveFile oggetti(I), cartella & Replace(e, "$", n) & "." & ext 'MsgBox oggetti(I) & VbCrlf & VbCrlf & cartella & Replace(e, "$", n) & "." & ext, 0, "prova" & I Next MsgBox "Operazione terminata!", 0, "Fine"
|
Post n°10 pubblicato il 16 Luglio 2015 da developer.web
Dim list, flist, listArr, listItem, oShell, oItem, jobFolder, objFso Dim oDir, oFolder, oFolders, oFile, oFiles, a, path list = "" flist = "" Set oShell = CreateObject("Shell.Application") Set oItem = oShell.BrowseForFolder(0, "Scegli la cartella di lavoro:", 0, "") If oItem Is Nothing Then Wscript.Quit End If jobFolder = oItem.Self.Path & "" Set oShell = Nothing Set oItem = Nothing Dim vIns : vIns = InputBox ("Inserisci cosa cercare:", "Ricerca", "") If vIns = "" Then Wscript.Quit End If list = "?" & jobFolder Do Until (InStr(1, list, "?") = 0) listArr = Split(list, "^") For Each listItem In listArr a = Mid(listItem, 1, 1) path = Mid(listItem, 2) If a = "?" Then Set objFso = CreateObject("Scripting.FileSystemObject") Set oDir = objFso.GetFolder(path) Set oFolders = oDir.SubFolders For Each oFolder In oFolders list = list & "^" & "?" & path & oFolder.Name & "" Next Set objFso = Nothing Set oDir = Nothing Set oFolders = Nothing list = Replace(list, "?" & path, path, 1, 1) End If Next Loop listArr = Split(list, "^") For Each path In listArr Set objFso = CreateObject("Scripting.FileSystemObject") Set oDir = objFso.GetFolder(path) Set oFiles = oDir.Files For Each oFile In oFiles flist = flist & "^" & path & oFile.Name Next Set objFso = Nothing Set oDir = Nothing Set oFiles = Nothing Next Dim filesys, filetxt, fcontent, s sresult = "" listArr = Split(flist, "^") For Each path In listArr If path <> "" Then Set filesys = CreateObject("Scripting.FileSystemObject") Set filetxt = filesys.OpenTextFile(path, 1, True) fcontent = filetxt.ReadAll s = InStr(1, fcontent, vIns) If s > 0 Then sresult = sresult & "#" & s & Replace(path, jobFolder, ".") & vbCrLf End If filetxt.Close Set filesys = Nothing Set filetxt = Nothing End If Next If sresult = "" Then MsgBox "Nessun risultato trovato", 0, ":-(" Else MsgBox sresult End If |
Post n°9 pubblicato il 05 Dicembre 2014 da developer.web
Public Class Form1 Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim sFso = CreateObject("Scripting.FileSystemObject") For i As Integer = 0 To 4 If sFso.FileExists("slot" & i & ".sav") Then Me.Controls("Button" & i).Enabled = True Else Me.Controls("Button" & i).Enabled = False End If Next sFso = Nothing End Sub Private Sub Button0_Click(sender As Object, e As EventArgs) Handles Button0.Click, Button1.Click, Button2.Click, Button3.Click, Button4.Click Dim savegame As String = sender.Text Dim alphabet As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" Dim myFile As IO.FileStream Dim cod As String = "" myFile = New IO.FileStream(savegame, IO.FileMode.Open, IO.FileAccess.Read) For k As Integer = 0 To 3 myFile.Seek(11608 + (k * 4), 0) cod &= Mid(alphabet, myFile.ReadByte, 1) Next myFile = Nothing mdiskCode.Text = cod mdiskCode.Visible = True Akuda.Visible = True End Sub End Class |
Post n°8 pubblicato il 13 Novembre 2014 da developer.web
Piccolo Script in VB che legge il savegeme del gioco Beyond Good & Evil per scovare il famigerato codice per avere il disco 13 col gioco di Francis. E praticamente ti evita di doverti iscriverti alla Darkroom.
Dim fso, savegame, i, lista, objFile, letto, k1, k2, k3, k4, alphabet, codice alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" lista = "" For i = 0 To 4 Set fso = CreateObject("Scripting.FileSystemObject") savegame = "slot" & i & ".sav" If fso.FileExists(savegame) Then Set objFile = fso.OpenTextFile(savegame, 1) letto = objFile.Read(11622) k1 = Asc(Mid(letto,11608+1,1)) k2 = Asc(Mid(letto,11612+1,1)) k3 = Asc(Mid(letto,11616+1,1)) k4 = Asc(Mid(letto,11620+1,1)) codice = Mid(alphabet,k1,1) & Mid(alphabet,k2,1) & Mid(alphabet,k3,1) & Mid(alphabet,k4,1) lista = lista & vbcrlf & savegame & " code: " & codice Set objFile = Nothing End If Set fso = Nothing Next If lista = "" Then MsgBox "No savegame files found !!", 0, " :: ALERT !!" Else MsgBox "Akuda Bar Box Code:" & vbcrlf & " " & lista, 0, " :: Mdisk #13" End If |
Post n°7 pubblicato il 03 Novembre 2014 da developer.web
Javascript: Convertire una stringa base64 in decimale
function base64toDEC (str) { var octArr = {"A":"00","B":"01","C":"02","D":"03","E":"04","F":"05","G":"06","H":"07", "I":"10","J":"11","K":"12","L":"13","M":"14","N":"15","O":"16","P":"17", "Q":"20","R":"21","S":"22","T":"23","U":"24","V":"25","W":"26","X":"27", "Y":"30","Z":"31","a":"32","b":"33","c":"34","d":"35","e":"36","f":"37", "g":"40","h":"41","i":"42","j":"43","k":"44","l":"45","m":"46","n":"47", "o":"50","p":"51","q":"52","r":"53","s":"54","t":"55","u":"56","v":"57", "w":"60","x":"61","y":"62","z":"63","0":"64","1":"65","2":"66","3":"67", "4":"70","5":"71","6":"72","7":"73","8":"74","9":"75","+":"76","/":"77"}; var i, oct = ""; for (i=0; i<str.length; i++) { oct += octArr[str.slice(i,i+1)]; } return parseInt(oct,8); } |