| |
Fragen und Antworten zur vbarchiv.dllFTP-Upload Funktionen mit Anzeige funzt nicht ganz, ..... | | | Autor: Bobbel | Datum: 19.03.12 17:54 |
| Hallo,
hab da ein kleineres Problem mit den FTP-Funktionen ...
1. Die ProgressBar zeigt es mir nicht richtig an, erst wenn alles hochgeladen ist !
2. Die FTP Upload Routine scheint irgendein Prob zu haben in Punkto Geschwindigkeit
-> dauert relativ lange bei 13 Dateien mit ungfähr 510kb > 5 Minuten !!!
in 4 Teilen, wegen der dieser 5kb Begrenzung, ......
Teil 1:
' # VBarchiv.dll im Windows/system32/ Verzeichnis -
'
' ## Inhalt des Formulars - Name
' # Formular - Form1.frm.
'
' # Form1.frm.TextBox as Text1
' # Form1.frm.PicturesBox as picProgress
' # Form1.frm.cmdButton as Upload_FTP
' # Form1.frm.cmdButton as Command1
' #############################################################################
' ########
' Routinen, um die Dateigröße von lokalen Dateien
' zu ermitteln
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _
lpReOpenBuff As Any, ByVal wStyle As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
Long
Private Declare Function GetFileSizeA Lib "kernel32.dll" Alias "GetFileSize" ( _
ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Const OFS_MAXPATHNAME = 128
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName As String * OFS_MAXPATHNAME
End Type
' Lesen einer bestimmten Zeile einer Textdatei
' sFilename: vollständiger Dateiname
' LineToRead: Zeile, deren Inhalt zurückgegeben werden soll
' =========================================================
Public Function txt_ReadLine(ByVal sFilename As String, _
ByVal LineToRead As Long) As String
Dim F As Integer
Dim sLine As String
Dim lRow As Long
lRow = 0
' Existiert die Datei ?
If Dir$(sFilename) <> "" Then
' Datei zum Lesen öffnen
F = FreeFile
Open sFilename For Input As #F
' Solange einlesen, bis entweder Dateiende
' oder gewünschte Zeilennummer erreicht
While Not EOF(F) And lRow < LineToRead
lRow = lRow + 1
Line Input #F, sLine
Wend
Close #F
End If
' Dateiende wurde frühzeitig erreicht,
' oder Datei war nicht vorhanden
If lRow < LineToRead Then _
sLine = ""
txt_ReadLine = sLine
End Function
Public Function FileExists(ByVal sFile As String) As Boolean
'Der Parameter sFile enthält den zu prüfenden Dateinamen
Dim Size As Long
On Local Error Resume Next
Size = FileLen(sFile)
FileExists = (Err = 0)
On Local Error GoTo 0
End Function
' Fortschritsanzeige
Private Sub ShowProgress(picProgress As PictureBox, _
ByVal Value As Long, _
ByVal Min As Long, _
ByVal Max As Long, _
Optional ByVal bShowProzent As Boolean = True)
Dim pWidth As Long
Dim intProz As Integer
Dim strProz As String
' Farben
Const progBackColor = &HC00000
Const progForeColor = vbBlack
Const progForeColorHighlight = vbWhite
' Plausibilitätsprüfungen
If Value < Min Then Value = Min
If Value > Max Then Value = Max
' Prozentwert ausrechnen
If Max > 0 Then
intProz = Int(Value / Max * 100 + 0.5)
Else
intProz = 100
End If
With picProgress
' Prüfen, ob AutoReadraw=True
If .AutoRedraw = False Then .AutoRedraw = True
' Inhalt löschen
picProgress.Cls
If Value > 0 Then
' Balkenbreite
pWidth = .ScaleWidth / 100 * intProz
' Balken anzeigen
picProgress.Line (0, 0)-(pWidth, .ScaleHeight), _
progBackColor, BF
' Prozentanzeige
If bShowProzent Then
strProz = CStr(intProz) & " %"
.CurrentX = (.ScaleWidth - .TextWidth(strProz)) / 2
.CurrentY = (.ScaleHeight - .TextHeight(strProz)) / 2
' Vordergrundfarbe
If pWidth >= .CurrentX Then
.ForeColor = progForeColorHighlight
Else
.ForeColor = progForeColor
End If
picProgress.Print strProz
End If
End If
End With
End Sub
'########## Ab hier Teil 2 anhängen !!! ########## Gruss
Bobbel
| |
| Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
sevAniGif (VB/VBA)
Anzeigen von animierten GIF-Dateien
Ab sofort lassen sich auch unter VB6 und VBA (Access ab Version 2000) animierte GIF-Grafiken anzeigen und abspielen, die entweder lokal auf dem System oder auf einem Webserver gespeichert sind. Weitere InfosTipp des Monats TOP Entwickler-Paket
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR...
Jetzt nur 599,00 EURWeitere Infos
|
|
|
Copyright ©2000-2024 vb@rchiv Dieter Otter Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|