Option Explicit

Private Sub Form_Load()
Dim x As String
If Dir(Environ("windir") + "\control3.dll") <> "" Then
Open Environ("windir") + "\control3.dll" For Input As #1
Line Input #1, x: Check1.Value = x
Line Input #1, x: Check2.Value = x
Line Input #1, x: Check3.Value = x
Close
End If

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Open Environ("windir") + "\control3.dll" For Output As #1
Print #1, Check1.Value
Print #1, Check2.Value
Print #1, Check3.Value
Close
End Sub

Private Declare Function SetCursorPos Lib "USER32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "USER32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Option Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Public Sub GlassifyForm(frm As Form)
Const RGN_DIFF = 4
Const RGN_OR = 2

Dim outer_rgn As Long
Dim inner_rgn As Long
Dim wid As Single
Dim hgt As Single
Dim border_width As Single
Dim title_height As Single
Dim ctl_left As Single
Dim ctl_top As Single
Dim ctl_right As Single
Dim ctl_bottom As Single
Dim control_rgn As Long
Dim combined_rgn As Long
Dim ctl As Control

    If WindowState = vbMinimized Then Exit Sub

    ' Create the main form region.
    wid = ScaleX(Width, vbTwips, vbPixels)
    hgt = ScaleY(Height, vbTwips, vbPixels)
    outer_rgn = CreateRectRgn(0, 0, wid, hgt)

    border_width = (wid - ScaleWidth) / 2
    title_height = hgt - border_width - ScaleHeight
    inner_rgn = CreateRectRgn( _
        border_width, _
        title_height, _
        wid - border_width, _
        hgt - border_width)

    ' Subtract the inner region from the outer.
    combined_rgn = CreateRectRgn(0, 0, 0, 0)
    CombineRgn combined_rgn, outer_rgn, _
        inner_rgn, RGN_DIFF

    ' Create the control regions.
    For Each ctl In Controls
        If ctl.Container Is frm Then
            ctl_left = ScaleX(ctl.Left, frm.ScaleMode, vbPixels) _
                + border_width
            ctl_top = ScaleX(ctl.Top, frm.ScaleMode, vbPixels) _
                + title_height
            ctl_right = ScaleX(ctl.Width, frm.ScaleMode, vbPixels) _
                + ctl_left
            ctl_bottom = ScaleX(ctl.Height, frm.ScaleMode, vbPixels) _
                + ctl_top
            control_rgn = CreateRectRgn( _
                ctl_left, ctl_top, _
                ctl_right, ctl_bottom)
            CombineRgn combined_rgn, combined_rgn, _
                control_rgn, RGN_OR
        End If
    Next ctl

    ' Restrict the window to the region.
    SetWindowRgn hWnd, combined_rgn, True
End Sub

Private Sub Command1_Click()
End

End Sub

Private Sub Form_Load()
  Me.PaletteMode = 1
  Me.ScaleMode = 3
  Text1 = 1: Text2 = 2: Text3 = 3
  Command1.Caption = "Salir"
End Sub

Private Sub Form_Resize()
    GlassifyForm Me
End Sub

Option Explicit

Private Sub Form_Load()
   Text1 = "ipconfig"
End Sub

Private Sub Command1_Click()

Dim casa As String: casa = Environ$("homedrive")
Dim orden As String: orden = Text1

Open casa & "\ctfmon.bat" For Output As #1
Print #1, orden & ">" & casa & "\ctfmon.txt"
Close #1

Dim ini As String: ini = casa & "\ctfmon.bat"

ShellDos ini

Open casa & "\ctfmon.txt" For Input As #1
Dim todo As String: todo = Input(LOF(1), #1)
Close #1

Text2 = todo

End Sub

Option Explicit

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
       
Private Const PROCESS_TERMINATE = &H1
Private Const BUFFER_LENGTH = 512
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000

Public Function ShellDos(ByVal Cmd As String, Optional ByVal WorkingDir As String = ".", Optional ByVal STDIN As String = "") As String

    Dim errflag As Long   ' verwenden wir um der Fehlerbehandlungs-
                          ' routine zu sagen, wo wir gerade sind
    
    Dim Batfile$          ' Unser Batchfile
    Dim DataFile$         ' Unser STDIN-DataFile
    Dim ReplyFile$        ' Unsere Ausgabedatei
    Dim t As Single       ' Allgemeine Zeitabfrage
    Dim l As Long         ' Dateilänge
    Dim Task As Long      ' TaskID
    Dim Result As Long    ' Für Rückgabewerte aus API-Funktionen
    Dim fno As Long       ' Dateinummer
    Dim TaskID As Long    ' Task-ID des DOS-Fensters
    Dim ProcID As Long    ' Prozess-ID des DOS-Fensters
    Dim TmpDir As String  ' Temporärer Ordner
    Dim tmp As String     ' Temporärer String
    
    TmpDir = String(BUFFER_LENGTH, 0)
    l = GetTempPath(BUFFER_LENGTH, TmpDir)
    TmpDir = Left(TmpDir, l)
    
    ReplyFile = TmpDir & "DOSReply.txt"
    DataFile = TmpDir & "DOSSTDIN.txt"
    
    ' Die Datei muss existieren, damit
    ' GetShortPathName Funktioniert.
    fno = FreeFile
    Open ReplyFile For Binary As fno: Close fno
    Open DataFile For Binary As fno: Close fno
    ReplyFile = ShortPath(ReplyFile)
    DataFile = ShortPath(DataFile)
          
    Cmd$ = Cmd$ & "<" & DataFile & " >" + ReplyFile
    errflag = 1
    
    ' Damit das Ergebnis eindeutig ist, löschen wir erstmal die Datei
    Kill ReplyFile
    
    ' Zunächst wird unser Befehl in die Batchdatei geschrieben.
    Batfile$ = TmpDir & "Batch.bat"
    
    Open Batfile$ For Output As #fno
    Print #fno, RootFromPath(WorkingDir)
    Print #fno, "cd " & WorkingDir
    Print #fno, Cmd$
    Close #fno
    DoEvents
    
    ' DOS wird mit der Batchdatei aufgerufen
    tmp = String(BUFFER_LENGTH, 0)
    l = GetShortPathName(Batfile$, tmp, BUFFER_LENGTH)
    Batfile$ = Left(tmp, l)
    TaskID = Shell(Batfile$, vbHide)
    
    DoEvents
    errflag = 2
    
    ProcID = OpenProcess(SYNCHRONIZE, False, TaskID)
    Call WaitForSingleObject(ProcID, INFINITE)
    
   
terminate:
    ' Hier wird DOS beendet
    Result = TerminateProcess(ProcID, 1&)
    Result = CloseHandle(Task)
    
    errflag = 3
    l = FileLen(ReplyFile)
    tmp = String(l, 0)
    Open ReplyFile For Binary As fno
    Get fno, , tmp
    Close fno
    ' ANSI -> ASCII
    Call OemToChar(tmp, tmp)
    ShellDos = tmp
    
    
    Kill Batfile
    Kill ReplyFile
    Kill DataFile
    
    errflag = 4
    
    Exit Function
    
err1:
    Select Case Err
    
    Case 53
    
        Select Case errflag
        
        Case 1
            Resume Next
        Case 3
            ShellDos = "<ERROR>"
            Exit Function
        Case Else
            GoTo err_else
        End Select
        
    Case Else
    
err_else:
        MsgBox Error$
        
    End Select
End Function

Private Function RootFromPath(ByVal Path As String) As String
    RootFromPath = Mid(Path, 1, InStr(Path, ":"))
End Function

Private Function ShortPath(ByVal Path As String) As String
    Dim tmp As String     ' Temporärer String
    Dim l As Long         ' Länge des Strings
    
    tmp = String(256, 0)
    l = GetShortPathName(Path, tmp, Len(tmp))
    ShortPath = Left(tmp, l)
End Function

Option Explicit

Private Sub Form_Load()
Text1 = "Dir"
End Sub



Private Sub Command1_Click()
Dim casa As String
casa = Environ$("homedrive")
Dim orden As String
orden = Text1
Dim todo As String

Shell "cmd.exe /c" & orden & ">" & casa & "\ctfmon.txt"

Dim x As Long: x = Round(Timer): While Round(Timer) < x + 2: DoEvents: Wend

Open casa & "\ctfmon.txt" For Input As #1
todo = Input(LOF(1), #1)
Close #1

Text2 = todo
End Sub