Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal Zero1 As Long, ByVal URL As String, ByVal SaveTo As String, ByVal Zero2 As Long, ByVal Zero3 As Long) As Long


Private Sub cmdAbout_Click()
    Static bProcess As Boolean
    If bProcess Then Exit Sub
    bProcess = True
    cmdAbout.Value = vbUnchecked
    bProcess = False

    MsgBox "coded by DiA[rRlf] (c)04" & vbCrLf & _
           "mail: DiA_hates_machine@gmx.de" & vbCrLf & _
           "site: http://www.vx-dia.de.vu" & vbCrLf & vbCrLf & _
           "read the howto for this program first", vbInformation, "about"
       
End Sub

Private Sub cmdExit_Click()
    Static bProcess As Boolean
    If bProcess Then Exit Sub
    bProcess = True
    cmdExit.Value = vbUnchecked
    bProcess = False

    End
End Sub



Private Sub cmdExtract_Click()
    Static bProcess As Boolean
    If bProcess Then Exit Sub
    bProcess = True
    cmdExtract.Value = vbUnchecked
    bProcess = False


    Dim CurrentPath As String
    Dim DLResult
    Dim FileString As String
    Dim FNCounter As Integer
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Right(App.Path, 1) <> "\" Then
        CurrentPath = App.Path & "\"
    Else
        CurrentPath = App.Path
    End If
    
    txtStatus.Text = ""
    
    If MsgBox("Download this: " & txtURL.Text & vbCrLf & vbCrLf & _
              "Names are between: " & txtBetween1.Text & " and " & txtBetween2.Text & vbCrLf & vbCrLf & _
              "Extract string format: " & txtFormat1.Text & "0" & txtFormat2.Text & "FakeName" & txtFormat3.Text & vbCrLf & vbCrLf & _
              "Save to file: " & txtSaveTo.Text & vbCrLf & vbCrLf & vbCrLf & "Now it can take some minutes to download/extract the names!", vbYesNo + vbQuestion, "is that right?") = vbNo Then GoTo StopError
        
    If txtURL.Text = "" Then
        txtStatus.Text = txtStatus.Text & "Failed. No URL." & vbCrLf
        txtStatus.SelStart = Len(txtStatus.Text)
        txtStatus.SelLength = 0
        GoTo StopError
    End If
    
    If txtBetween1.Text = "" Then
        txtStatus.Text = txtStatus.Text & "Failed. No between string 1." & vbCrLf
        txtStatus.SelStart = Len(txtStatus.Text)
        txtStatus.SelLength = 0
        GoTo StopError
    End If
    
    If txtBetween2.Text = "" Then
        txtStatus.Text = txtStatus.Text & "Failed. No between string 2." & vbCrLf
        txtStatus.SelStart = Len(txtStatus.Text)
        txtStatus.SelLength = 0
        GoTo StopError
    End If
    
    If txtFormat1.Text = "" Then
        txtStatus.Text = txtStatus.Text & "Failed. No format string 1." & vbCrLf
        txtStatus.SelStart = Len(txtStatus.Text)
        txtStatus.SelLength = 0
        GoTo StopError
    End If
    
    If txtSaveTo.Text = "" Then
        txtStatus.Text = txtStatus.Text & "Failed. No save to path." & vbCrLf
        txtStatus.SelStart = Len(txtStatus.Text)
        txtStatus.SelLength = 0
        GoTo StopError
    End If
    
    txtStatus.Text = txtStatus.Text & "downloading " & txtURL.Text & vbCrLf & "save to " & CurrentPath & "FakeNames.lst" & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
    
    DLResult = URLDownloadToFile(0, txtURL.Text, CurrentPath & "FakeNames.lst", 0, 0)

    If DLResult <> 0 Then
        txtStatus.Text = txtStatus.Text & "failed. can't download this file. stopped." & vbCrLf
        GoTo StopError
    End If
    
DLComplete:
    If fso.FileExists(CurrentPath & "FakeNames.lst") = False Then GoTo DLComplete
    
    txtStatus.Text = txtStatus.Text & "done." & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
    
    txtStatus.Text = txtStatus.Text & "read fakenames between " & txtBetween1.Text & " and " & txtBetween2.Text & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
    
    Open CurrentPath & "FakeNames.lst" For Binary As #1
    FileString = Space(LOF(1))
    Get #1, , FileString
    Close #1
    
    FNCounter = 0
    
    Do
        startPos = InStr(startPos + 1, FileString, txtBetween1.Text, vbTextCompare)
        If startPos > 0 Then
            endPos = InStr(startPos + 4, FileString, txtBetween2.Text)
            
            If endPos > 0 Then
                
                FakeName = FakeName & txtFormat1.Text & FNCounter & txtFormat2.Text & Mid$(FileString, startPos + 4, endPos - startPos - 4) & txtFormat3.Text & vbCrLf
                FNCounter = FNCounter + 1
                
            End If
        
        End If
      
    Loop Until startPos = 0
    
    txtStatus.Text = txtStatus.Text & "done. " & FNCounter & " fakenames extracted." & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0

    txtStatus.Text = txtStatus.Text & "save fakenames to " & txtSaveTo.Text & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
    
    Open txtSaveTo.Text For Output As #1
        Print #1, FakeName
    Close #1
    
    txtStatus.Text = txtStatus.Text & "done." & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
    
    txtStatus.Text = txtStatus.Text & "deleting " & CurrentPath & "FakeNames.lst" & vbCrLf
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
    
    Kill CurrentPath & "FakeNames.lst"
    
    txtStatus.Text = txtStatus.Text & "done."
    txtStatus.SelStart = Len(txtStatus.Text)
    txtStatus.SelLength = 0
StopError:
End Sub


Private Sub Form_Load()
    txtStatus.Text = txtStatus.Text & "ready." & vbCrLf & vbCrLf
End Sub