Visual Basic loopt vast door muis klik

Status
Niet open voor verdere reacties.
F

Fergon

Nieuwe gebruiker
Lid geworden
26 jul 2008
Berichten
4
Hallo,

Ik ben bezig een backup programma te maken voor m’n exterene harde schijf mbv Visual Basic Sudio 2008. Nu loop ik tegen het volgende probleem aan waar ik maar geen oplossing voor kan vinden:

Wanneer je het script laat lopen en je klikt daarna met de muis op het formulier, dan loopt het vast, en komt er boven in het formulier balk te staan “Reageert niet” Dit gebeurd vanaf de regel: For Each COPYFROMFOLDER As String In My.Computer.FileSystem.GetFiles((IDBRONMAP), FileIO.SearchOption.SearchAllSubDirectories).
Wie weet hiervoor de oplossing. Alvast bedankt.
fmeinen@freeler.nl

Hieronder het script:

Public Class FormADOBEPHOTOSHOP
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If My.Computer.Keyboard.CapsLock Then
Call keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 1, 0)
Call keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 3, 0)
End If
Dim IDCOMPUTER As String
Dim IDGEBRUIKER As String
Dim IDBACKUPDATUM As String
Dim IDBACKUPTIJD As String
Dim IDBACKUPMAP As String
Dim IDPROGRAMMAP As String
Dim IDBRONMAP As String
Dim IDCURRENTMAP As String
Dim IDLOGMAP As String
Dim IDLOGFILE As String
Dim FILETELLER As String
Dim AANTALBESTAND As Long
IDCOMPUTER = SystemInformation.ComputerName
IDGEBRUIKER = Environment.UserName
IDBACKUPDATUM = "Datum backup: " & Format(Now(), "dddd d MMMM yyyy")
IDBACKUPTIJD = "Tijd: " & Format(Now(), "short time")
IDCURRENTMAP = "c:\Mijn documenten"
IDPROGRAMMAP = "Adobe Photoshop"
IDBACKUPMAP = "Z:\PROGRAMFILES\240557_" & IDPROGRAMMAP
IDBRONMAP = IDCURRENTMAP & "\" & IDPROGRAMMAP
IDLOGMAP = "C:\BackupZDrive\Log\" & IDPROGRAMMAP
IDLOGFILE = IDPROGRAMMAP & " " & Format((Now), " dd-MM-yy_") & Format(Now(), "short time")
PB1.Value = Val(PB1.Value) + 1
If PB1.Value = 5 Then
Timer1.Stop()
TextBox1.Text = IDLOGMAP
TextBox2.Text = IDLOGFILE
TextBox3.Text = IDBACKUPTIJD
TextBox4.Text = AANTALBESTAND
For Each COPYFROMFOLDER As String In My.Computer.FileSystem.GetFiles((IDBRONMAP), FileIO.SearchOption.SearchAllSubDirectories)
Dim SOURCEFILE As String = Replace((COPYFROMFOLDER), (IDPROGRAMMAP), "")
TextBox5.Text = SOURCEFILE
Dim timeOut01 As DateTime = Now.AddMilliseconds(1250)
Do
Loop Until Now > timeOut01
Refresh
Next
End If
If PB1.Value = 100 Then
Me.Close()
End If
End Sub

End Class
 
Fergon zei:
Hallo,

Ik ben bezig een backup programma te maken voor m’n exterene harde schijf mbv Visual Basic Sudio 2008. Nu loop ik tegen het volgende probleem aan waar ik maar geen oplossing voor kan vinden:

Wanneer je het script laat lopen en je klikt daarna met de muis op het formulier, dan loopt het vast, en komt er boven in het formulier balk te staan “Reageert niet” Dit gebeurd vanaf de regel: For Each COPYFROMFOLDER As String In My.Computer.FileSystem.GetFiles((IDBRONMAP), FileIO.SearchOption.SearchAllSubDirectories).
Wie weet hiervoor de oplossing. Alvast bedankt.
fmeinen@freeler.nl

Hieronder het script:

Public Class FormADOBEPHOTOSHOP
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If My.Computer.Keyboard.CapsLock Then
Call keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 1, 0)
Call keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 3, 0)
End If
Dim IDCOMPUTER As String
Dim IDGEBRUIKER As String
Dim IDBACKUPDATUM As String
Dim IDBACKUPTIJD As String
Dim IDBACKUPMAP As String
Dim IDPROGRAMMAP As String
Dim IDBRONMAP As String
Dim IDCURRENTMAP As String
Dim IDLOGMAP As String
Dim IDLOGFILE As String
Dim FILETELLER As String
Dim AANTALBESTAND As Long
IDCOMPUTER = SystemInformation.ComputerName
IDGEBRUIKER = Environment.UserName
IDBACKUPDATUM = "Datum backup: " & Format(Now(), "dddd d MMMM yyyy")
IDBACKUPTIJD = "Tijd: " & Format(Now(), "short time")
IDCURRENTMAP = "c:\Mijn documenten"
IDPROGRAMMAP = "Adobe Photoshop"
IDBACKUPMAP = "Z:\PROGRAMFILES\240557_" & IDPROGRAMMAP
IDBRONMAP = IDCURRENTMAP & "\" & IDPROGRAMMAP
IDLOGMAP = "C:\BackupZDrive\Log\" & IDPROGRAMMAP
IDLOGFILE = IDPROGRAMMAP & " " & Format((Now), " dd-MM-yy_") & Format(Now(), "short time")
PB1.Value = Val(PB1.Value) + 1
If PB1.Value = 5 Then
Timer1.Stop()
TextBox1.Text = IDLOGMAP
TextBox2.Text = IDLOGFILE
TextBox3.Text = IDBACKUPTIJD
TextBox4.Text = AANTALBESTAND
For Each COPYFROMFOLDER As String In My.Computer.FileSystem.GetFiles((IDBRONMAP), FileIO.SearchOption.SearchAllSubDirectories)
Dim SOURCEFILE As String = Replace((COPYFROMFOLDER), (IDPROGRAMMAP), "")
TextBox5.Text = SOURCEFILE
Dim timeOut01 As DateTime = Now.AddMilliseconds(1250)
Do
Loop Until Now > timeOut01
Refresh
Next
End If
If PB1.Value = 100 Then
Me.Close()
End If
End Sub

End Class
Klik om te vergroten...

Ik denk dat je het beste met een backgroundworker moet gaan werken!!
Offtopic: Ik denk dat je je volgende posts over Visual Basic 2008 maar moet posten in Programmeren >> .NET > VB.NET
want de taal die wordt gebruikt in VB heet vanaf Visual Basic 2002 VB.NET
 
WILLIAMXXX zei:
Volgens mij heb je .NET vanaf 2001;)
Klik om te vergroten...

Code: 
Visual Basic .NET (sinds 2002)
Visual Basic 7.0 en latere versies hebben een grote oppervlakkige gelijkenis met de zojuist genoemde eerdere Visual Basics, maar zijn op een totaal nieuwe ondergrond gebaseerd: het .NET-framework. Hiermee wordt Visual Basic een door en door objectgeoriënteerde taal, zeer vergelijkbaar met C# of Java. Daarnaast verandert het karakter van de naam Visual Basic enigszins: die slaat nu specifiek op de programmeertaal, omdat de ondersteunende softwarebibliotheken en de runtime-ondersteuning ook worden gebruikt door alle andere .NET-talen, zoals C#. Ook heeft de taal een openbare specificatie.

Zoals de runtime van Visual Basic 6 is ook de .NET-runtime (beter bekend als het .NET-framework) vrij verkrijgbaar als download op microsoft.com, en wordt daarnaast meegeleverd met automatische Windows-updates en Windows Vista.

De verschillende versies zijn:

Visual Basic 7 (voor .NET 1.0, uitgekomen 16 januari 2002, en .NET 1.1, uitgekomen 24 april 2003) 
Visual Basic 8 (voor .NET 2.0, uitgekomen 7 november 2005) 
Visual Basic 9 (voor .NET 3.5, uitgekomen eind 2007) 
Visual Basic 10 (voor o.a. Silverlight

bron Wikipedia!
 
Laatst bewerkt:
Muis blokkeren met Blockinput

Om even bij de vraag te blijven:

Ik heb een paar voorbeelden gevonden op het internet van de backgroudworker. Maar daar kom ik zo een twee drie niet uit. Dus dat heeft even tijd nodig. Maar ik heb een alternatief gevonden: Blokkeer de muis tijdens de backup met BlockInput(True). Het heeft een nadeel: Je kunt tijdens de backup niets beginnen met de muis en het toetsenbord. Maar vastlopen dat doet het niet meer. Dus tijdens de backup maar iets anders gaan doen.



Public Class FormADOBEPHOTSHOP
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If My.Computer.Keyboard.CapsLock Then
Call keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 1, 0)
Call keybd_event(System.Windows.Forms.Keys.CapsLock, &H14, 3, 0)
End If
Dim IDCOMPUTER As String
Dim IDGEBRUIKER As String
Dim IDBACKUPDATUM As String
Dim IDBACKUPTIJD As String
Dim IDBACKUPMAP As String
Dim IDPROGRAMMAP As String
Dim IDBRONMAP As String
Dim IDCURRENTMAP As String
Dim IDLOGMAP As String
Dim IDLOGFILE As String
Dim FILETELLER As String
Dim AANTALBESTAND As Long
IDCOMPUTER = SystemInformation.ComputerName
IDGEBRUIKER = Environment.UserName
IDBACKUPDATUM = "Datum backup: " & Format(Now(), "dddd d MMMM yyyy")
IDBACKUPTIJD = "Tijd: " & Format(Now(), "short time")
IDCURRENTMAP = "C:\Mijn documenten"
IDPROGRAMMAP = "Adobe Photoshop"
IDBACKUPMAP = "Z:\PROGRAMFILES\240557_" & IDPROGRAMMAP
IDBRONMAP = IDCURRENTMAP & "\" & IDPROGRAMMAP
IDLOGMAP = "C:\BackupZDrive\Log\" & IDPROGRAMMAP
IDLOGFILE = IDPROGRAMMAP & " " & Format((Now), "dd/MM/yy_") & Format(Now(), "hhmm") & ".txt"
PB1.Value = Val(PB1.Value) + 1
Label1.Text = "Backup " & IDPROGRAMMAP
For Each COPYFROMFOLDER As String In My.Computer.FileSystem.GetFiles((IDBRONMAP), FileIO.SearchOption.SearchAllSubDirectories)
FILETELLER = Dir(COPYFROMFOLDER)
Do Until Len(FILETELLER) = 0
FILETELLER = Dir()
AANTALBESTAND = AANTALBESTAND + 1
Loop
Next
If PB1.Value = 2 Then
Timer1.Stop()
If My.Computer.FileSystem.FileExists("C:\DeleteThumbs.bat") Then
My.Computer.FileSystem.DeleteFile("C:\DeleteThumbs.bat")
End If
If My.Computer.FileSystem.FileExists("C:\DeleteThumbsbatfile.bat") Then
My.Computer.FileSystem.DeleteFile("C:\DeleteThumbsbatfile.bat")
End If
Timer1.Start()
End If
If PB1.Value = 5 Then
Timer1.Stop()
If My.Computer.FileSystem.FileExists("C:\DeleteThumbs.bat") Then
PB1.Value = 1
Else
Dim writeDELTHB As New System.IO.StreamWriter("C:\DeleteThumbs.bat")
writeDELTHB.Write("cd /d " & IDBRONMAP & "\" + ControlChars.NewLine + "attrib +a -s -h -r thumbs.db /s" + ControlChars.NewLine + "del /s /f thumbs.db" + ControlChars.NewLine + "PING -n 1 127.0.0.1>nul" + ControlChars.NewLine + "C:\DeleteThumbsbatfile.bat")
writeDELTHB.Close()
Timer1.Start()
End If
End If
If PB1.Value = 10 Then
Timer1.Stop()
Dim writeDELTHB02 As New System.IO.StreamWriter("C:\DeleteThumbsbatfile.bat")
writeDELTHB02.Write("del C:\DeleteThumbs.bat")
writeDELTHB02.Close()
Timer1.Start()
End If
If PB1.Value = 15 Then
Timer1.Stop()
If My.Computer.FileSystem.FileExists("C:\DeleteThumbsbatfile.bat") Then
Shell("C:\DeleteThumbs.bat", AppWinStyle.Hide)
Timer1.Start()
Else
PB1.Value = 9
Timer1.Start()
End If
End If
If PB1.Value = 20 Then
Timer1.Stop()
If My.Computer.FileSystem.FileExists("C:\DeleteThumbsbatfile.bat") Then
My.Computer.FileSystem.DeleteFile("C:\DeleteThumbsbatfile.bat")
Timer1.Start()
Else
PB1.Value = 19
Timer1.Start()
End If
End If
If PB1.Value = 25 Then
BlockInput(True)
PB1.Visible = False
PB3.Visible = True
Label2.Text = "Backup loopt...."
For Each COPYFROMFOLDER As String In My.Computer.FileSystem.GetFiles((IDBRONMAP), FileIO.SearchOption.SearchAllSubDirectories)
Dim SOURCEFILE As String = (COPYFROMFOLDER)
Dim IDFILEBACKUP As String = Replace((COPYFROMFOLDER), (IDBRONMAP), "")
Dim BACKUPFILE As String = IDBACKUPMAP & IDFILEBACKUP
Dim LENGTESOURCE As System.IO.FileInfo
Dim LENGTEBACKUP As System.IO.FileInfo
Dim TELLERFILE As String
Dim OPTELTELLER As Long
TELLERFILE = Dir((COPYFROMFOLDER))
LENGTESOURCE = My.Computer.FileSystem.GetFileInfo(SOURCEFILE)
LENGTEBACKUP = My.Computer.FileSystem.GetFileInfo(BACKUPFILE)
PB2.Value = 1
If PB2.Value = 1 Then


PB2.Value = 10
Refresh()
End If
If PB2.Value = 10 Then
If My.Computer.FileSystem.FileExists(BACKUPFILE) Then
PB2.Value = 20
Else
My.Computer.FileSystem.CopyFile((SOURCEFILE), (BACKUPFILE), True)
PB2.Value = 10
End If
End If
If PB2.Value = 20 Then
End If

Do Until Len(TELLERFILE) = 0
TELLERFILE = Dir()
OPTELTELLER = OPTELTELLER + 1
Loop
PB3.Value = ((OPTELTELLER) / (AANTALBESTAND)) * 100
Label19.Text = "Bestanden gekopieert: " & (OPTELTELLER) & " van " & (AANTALBESTAND) & " - " & Format((OPTELTELLER) / (AANTALBESTAND) * 100, "0.0") & " %"
Next
PB1.Value = 55
Timer1.Start()
End If
If PB1.Value = 65 Then
Timer1.Stop()

PB3.Visible = False
PB1.Visible = True
Label2.Text = "Backup afsluiten....Even geduld a.u.b."
Dim writeLOG As New System.IO.StreamWriter(IDLOGMAP & "\" & IDLOGFILE)
writeLOG.Write("BACKUP GEGEVENS" + ControlChars.NewLine + IDPROGRAMMAP + ControlChars.NewLine + ControlChars.NewLine + IDBACKUPDATUM + ControlChars.NewLine + IDBACKUPTIJD + ControlChars.NewLine + ControlChars.NewLine + "Computer: " & IDCOMPUTER + ControlChars.NewLine + "Gebruiker: " & IDGEBRUIKER + ControlChars.NewLine + "Backup directory: " & IDBRONMAP + ControlChars.NewLine + "Doel directory: " & IDBACKUPMAP + ControlChars.NewLine + "Aantal bestanden: " & (AANTALBESTAND))
writeLOG.Close()
PB1.Value = 70
Timer1.Start()
End If

If PB1.Value = 90 Then
Timer1.Stop()
If My.Computer.FileSystem.FileExists(IDLOGMAP & "\" & IDLOGFILE) Then
PB1.Value = 95
Timer1.Start()
Else
PB1.Value = 89
Timer1.Start()
End If
End If
If PB1.Value = 100 Then
BlockInput(False)
Me.Close()
End If
End Sub


End Class
 
Laatst bewerkt:
Vastlopen, echt of niet?

Ik heb hetzelfde probleem met mijn programma om wortels te herleiden. Maar er is een verschil tussen vastlopen, en denken dat een programma vastloopt. Bij een loopje denkt windows: dat programma loopt vast, stop met het vernieuwen van beeld, zet reageert niet in de titelbalk.... Maar het programma is gewoon hard bezig, en loopt niet vast.

Misschien kan je de 'engine' in een ander bestand zetten, zodat het los staat van de GUI?

Trouwens... volgens mij is vb 6 sneller dan nieuwere versiesies(800.000 berekeningen per s, vb 2008 750 berekeningen per s)
 
rubendecoolste zei:
Ik heb hetzelfde probleem met mijn programma om wortels te herleiden. Maar er is een verschil tussen vastlopen, en denken dat een programma vastloopt. Bij een loopje denkt windows: dat programma loopt vast, stop met het vernieuwen van beeld, zet reageert niet in de titelbalk.... Maar het programma is gewoon hard bezig, en loopt niet vast.

Misschien kan je de 'engine' in een ander bestand zetten, zodat het los staat van de GUI?

Trouwens... volgens mij is vb 6 sneller dan nieuwere versiesies(800.000 berekeningen per s, vb 2008 750 berekeningen per s)
Klik om te vergroten...

Waarschijnlijk bedoel je hiermee multithreading?
Zo wordt de GUI geupdatet en worden de berekeningen gedaan. Dit is de uitgebreide variant van de BGWorker.
Heel handig, maar pain in the ass om te programmeren. Je mag namelijk dubbel werk doen wil je alles kunnen gebruiken e.d.
(eveneens bij de bgworker, voor crossthread operaties ... in java is dit 100x simpeler, maar dit terzijde)
 
Dè oplossing

Hey, ik heb nu iets simpelers.
Ik programmeer zelf dus in VB6, omdat dat duizend x sneller is met loops(misschien dat je je programma terug kan converten als je dat wilt?)
Ik heb het opgelost door een API timer en om de 100 ms DoEvents te gebruiken. Daardoor verlies je bijna geen snelheid, omdat hij anders 10 x per ms update. Hier is de code:
Code: 
Private Declare Function GetTickCount Lib "kernel32" () As Long 'de api
Dim tickOLD as long

'dit zet je in je lus:
If (GetTickCount - tickOLD) >= 100 Then 'als 100 ms geweest zijn 
    tickOLD = GetTickCount    'tickOLD updaten
    DoEvents 'programma updaten, alles refreshen
End If
Dit scheelt een hoop moeilijk gedoe, en werkt perfect, (bijna) zonder snelheidsverlies!:cool::thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan