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

 

Archivio messaggi

 
 << Luglio 2024 >> 
 
LuMaMeGiVeSaDo
 
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31        
 
 

I miei link preferiti

 

Cerca in questo Blog

  Trova
 

Tag

 
RSS (Really simple syndication) Feed Atom
 
 

Ultime visite al Blog

developer.webcarloserravalleLisa20141RangoBassofugadallanimaMaAnkeNoXkeSiBardamutoacer.250autumninrom0Alberi_Nuovilubopokant.333quinoa1977valentinachiummofabrizievole
 

NO TROLL

 

 

VBScript Elencante VBS v 2.0

Post n°11 pubblicato il 02 Novembre 2017 da developer.web
 

 


' 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"

 

 
 
 

VBScript Cercare stringa all'interno di un gruppo di files

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

 
 
 

Beyond Good & Evil - Akuda Bar Box Code for Mdisk13 (VB.net)

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
 
 
 

Beyond Good & Evil - Akuda Bar Box Code for Mdisk13

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.

Aprite Notepad e incollate questo Script in un nuovo documento. Salvate il tutto con estensione .vbs, e avrete così il vostro "scova codici".  Basterà inserirlo nella cartella di gioco vicino i file savegame e lui ne leggera il contenuto per scovarne i codici.

 

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
 
 
 

Javascript: Convertire una stringa base64 in decimale

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);
}
 
 
 
Successivi »
 
 
 

© Italiaonline S.p.A. 2024Direzione e coordinamento di Libero Acquisition S.á r.l.P. IVA 03970540963