Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
 
Private Sub Form_Load()
Dim Beg As Long, Mes As String
Mes = "String Nuevo"
Beg = BeginUpdateResource("C:\EjecutablePrueba.exe", False)
Call UpdateResource(Beg, "String Table", 7, 3082, ByVal StrPtr(Mes), LenB(Mes) + 2)
Call EndUpdateResource(Beg, 0)
End Sub

STRINGTABLE
LANGUAGE LANG_SPANISH, 0x3
{
9232, 	"String Nuevo"
}

• Un timer (Nombre: Timer1)
  
• Case
• IIF
• If
• Funciones
• Sub's
• Variables

Dim TiempoAtenuacion As Long

Private Sub Form_Load()
TiempoAtenuacion = 10
Timer1.Interval = 10
End Sub

Private Sub Timer1_Timer()
Select Case TiempoAtenuacion
    Case Is = 150
        Timer1.Interval = 0
        Timer1.Enabled = False
        Me.Show
    Case Else
        Call Atenuar
        Call SumarIntervalo
End Select
TiempoAtenuacion = Timer1.Interval
End Sub

Private Function Atenuar()
Dim Estado As String
Estado = IIf(Me.Visible, "Encendido", "Apagado")
If Estado = "Encendido" Then
    Me.Hide
ElseIf Estado = "Apagado" Then
    Me.Show
End If
End Function

Private Sub SumarIntervalo()
    Timer1.Interval = Timer1.Interval + 5
End Sub

Private Function ApplyStyle(ByVal Obj As Object, Optional ByVal Tipo As BorderStyleConstants, _
        Optional ByVal Color As Long) As Long
On Error GoTo CreateObjectLine: Randomize
CreateObjectLine: ' Etiqueta, si ocurre un error al crear la linea, intenta de nuevo
With Me.Controls.Add("VB.Shape", "ShapeGrap" & CLng((CLng(Rnd * 999) * 999) + Err.Number))
    On Error GoTo 0: On Error Resume Next ' Desactivar deteccion de err., iniciar detector de err.
    Obj.BorderStyle = 0 ' Se cumple solo si el objeto admite esta Propiedad
    Obj.Appearance = 0 ' Se cumple solo si el objeto admite esta Propiedad
    .Top = Obj.Top - 10
    .Left = Obj.Left - 10
    .Width = Obj.Width + 23
    .Height = Obj.Height + 23
    If Tipo = 0 Then Tipo = vbBSSolid ' Si la variable Tipo [Opcional] no se a definido
    .BorderStyle = Tipo
    .BorderColor = Color
    .Visible = True: Err.Clear
    .Tag = "PropertyApplyStyle"
End With
End Function

Call ApplyStyle(Objeto, Tipo_De_Borde[Opcional], Color_RGB_o_ColorConstans[Opcional]

Call ApplyStyle(Text1, vbBSSolid, RGB(200, 200, 200))

Call ApplyStyle(Text1, vbBSDashDotDot, VbGreen)

Call ApplyStyle(Text1)

Private Function DestroyApplyStyle() As Long
On Error Resume Next: Dim Obj As Object
For Each Obj In Form1.Controls
    If Obj.Tag = "PropertyApplyStyle" Then
        Me.Controls.Remove Obj
    End If
    Obj.BorderStyle = 1
    Obj.Appearance = 1
    DoEvents
Next
End Function

Call DestroyApplyStyle()

@Echo off
:Main
set /p nn=Escriba un Numero:/^>
set final=
:bin
set /a num=%nn%
set /a bnn=%num%/2
set /a mod=%bnn%+%bnn%
if ["%mod%"] EQU ["%num%"] (
   Set final=0%final%
) ELSE (
   set final=1%final%
)
if ["%bnn%"] NEQ ["0"] (
   Set /a nn=%bnn%
   Goto:bin
)
Echo %final%
goto:main

Escriba un Numero:/>123456789
111010110111100110100010101

@Echo off
(
echo e100 B8 1 0'3'DB CD'3'B0 3'C'CD'3'B DB't'FA 91 D3 EA D3 E8 91 C3
echo g116
echo q
)>tmps.dat
Debug<tmps.dat|Find /I "X"
Pause>nul

AX=0003  BX=0001  CX=0038  DX=0014  SP=FFEE  BP=0000  SI=0000  DI=0000

@Echo off
:g
(
echo e100 B8 1 0'3'DB CD'3'B0 3'C'CD'3'B DB't'FA 91 D3 EA D3 E8 91 C3
echo g116
echo q
)>tmps.dat
Debug<tmps.dat|Find /I "X"
Goto:g
 

@Echo off
(
echo e100 B8 1 0'3'DB CD'3'B0 3'C'CD'3'B DB't'FA 91 D3 EA D3 E8 91 C3
echo g116
echo q
)>Zmouse.txt
Mode Con Cols=80 lines=25
SetLocal ENABLEDELAYEDEXPANSION
cls
Echo                                                                              [X]
Echo.
Echo.
Echo.
Echo                      Presina un Boton:
Echo.
Echo.
Echo                      +------+          +------+
Echo                      +  Ok  +          +Cancel+
Echo                      +------+          +------+
:g
Del /Q /A ZDats>nul 2>&1
Debug< Zmouse.txt |Find /i "x">ZDats
Call:x
call:y
Call:Back
Call:mous "0015 0016 0017 0018 0019 001A 001B 001C" "%CX%" "0007 0008 0009" "%DX%"
If %state% EQU OK (Msg * Usted Presiono el Boton OK!!!)
Call:mous "0027 0028 0029 002A 002B 002C 002D 002E" "%CX%" "0007 0008 0009" "%DX%"
If %state% EQU OK (Msg * Usted Presiono el Boton Cancelar!!!)
Call:mous "004E" "%CX%" "0000" "%DX%"
If %state% EQU OK (Exit)
Set /p= X:%CX% ::: Y:%DX%<nul
)
Goto:g
 
:X
Set /p LineCode=<ZDats
for /f "Tokens=3" %%_ in ('Type ZDats') do (
Set %%_
Goto:eof
)
 
:Y
Set /p LineCode=<ZDats
for /f "Tokens=4" %%_ in ('Type ZDats') do (
Set %%_
Goto:eof
)
 
:Back
for /f "tokens=*" %%a in ('ipconfig') do (
Set /p=%%a<nul
Goto :eof
)
 
:mous
Set DMous=%2
Set DMous=!DMous!% style="color: #448888;">4
for %%m in (%~1) do (
	for %%n in (%~3) do (
		if !DMous! EQU "%%m""%%n" (
			Set state=OK
			Set CX=0000
			Set DX=0000
			Goto:eof
		) ELSE (
			Set state=NO
		)
	)
)
Goto:eof

' :::::::::::::::::::::::::::::::::::::::::::::::::
'          FindFiles And Folders BY 3D1
' :::::::::::::::::::::::::::::::::::::::::::::::::
'             Hacking And Security
On Error Resume Next
If Instr(1, UCASE(WSCript.FullName), UCASE("CSCript.exe")) = 0 Then
	MsgBox " Modo de Uso:" & Vbnewline & _
		"   CSCript //Nologo " & WSCript.ScriptFullName & VbNewline
	WSCript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
WSCript.Echo ""
WSCript.Echo ""
Directorio = DirB
Archivo = FileB
WSCript.Echo "  ----------------------------- "
WSCript.Echo "   Buscando Espere... "
WSCript.Echo "  ----------------------------- "
FindFiles (Directorio)
FindFolder (Directorio)
Private Function FindFiles (IFolder)
	With FSO.GetFolder(IFolder)
		For Each Fil in .Files
			If InStr(1, UCASE(Fil.Name), UCASE(Archivo)) <> 0 Then
				WSCript.Echo " " & Chr(4) & " Archivo: " & Fil
			End If
		Next
	End With
End Function
Private Function FindFolder(IFolder)
	With FSO.GetFolder(IFolder)
		For Each Fol in .SubFolders
			If InStr(1, UCASE(Fol.Name), UCASE(Archivo)) <> 0 Then
				WSCript.Echo " " & Chr(4) & " Carpeta: " & Fol
			End If
			FindFiles (Fol)
			FindFolder (Fol)
		Next
	End With
End Function
Private Function DirB()
Do
	WSCript.StdOut.Write "   Ruta Carpeta Donde Buscar: "
	X = WSCript.StdIn.ReadLine
	If FSO.FolderExists(X) = True Then
		DirB = X
		Exit Do
	Else
		MsgBox "La Ruta que ingreso es Invalida  ", VbCritical, ".::FindFiles And Folders BY 3D1::."
	End If
Loop
End Function
Private Function FileB()
	WSCript.StdOut.Write "   Archivo/Carpeta a Buscar: "
	FileB = WSCript.StdIn.ReadLine
End Function