|
| |
Fortgeschrittene Programmierung| Re: Zugriff auf Pocket PC wie im Windows Explorer | |  | | Autor: Mattes | | Datum: 05.07.07 09:49 |
| Public Function ImportFileFromPPC() As Boolean
Dim CreateFileHandle As Long
Dim ReadFileHandle As Integer
Dim Dateinummer As Integer
Dim lngBytesRead As Long
Dim i As Long
Dim n As Long
Dim PgbStep As Long
Dim PathFileName As String
Dim ImportString As String
Dim litem As ListItem
Dim bytBuffer() As Byte
Dim SecAtt As SECURITY_ATTRIBUTES
Dim BytesToRead As Long
Dim iFileTransferCounter As Long
Dim boTransferFehler As Boolean
If OnErrorFlag_1 = "1" Then
On Error Resume Next
End If
If boAktionsMerker = True Then Exit Function
boAktionsMerker = True
For i = 1 To lsvPPC.ListItems.Count
lsvPPC.ListItems(i).SubItems(5) = ""
Next i
pgbPPCImport.value = 0
iFileTransferCounter = 0
boTransferFehler = False
If lsvPPC.ListItems.Count > 0 Then
frmPpcPc.MousePointer = vbHourglass
For i = 1 To lsvPPC.ListItems.Count
Set litem = lsvPPC.ListItems.Item(i)
If litem.Checked = True Then
PathFileName = "\Programme\DataTrans\Protokolle\" + litem.SubItems(6)
CreateFileHandle = CeCreateFile(StrPtr(PathFileName), GENERIC_READ, _
FILE_SHARE_READ, SecAtt, _
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
If CreateFileHandle = INVALID_HANDLE Then
'MsgBox "File " & txtPPCFile.Text & " Not Found. Operation Aborted.", vbOKOnly
ImportFileFromPPC = False
frmPpcPc.MousePointer = vbDefault
Exit Function
End If
lblPpcImportFile = strTransferX + Chr(32) + litem.SubItems(6)
ReDim bytBuffer(CLng(litem.SubItems(7)))
'ReadFileHandle = CeReadFile(CreateFileHandle, bytBuffer(0), PPCFileSizeList(i), lngBytesRead, 0)
'ReadFileHandle = CeReadFile(CreateFileHandle, bytBuffer(0), CLng(litem.SubItems(7)), lngBytesRead, 0)
ReadFileHandle = CeReadFile(CreateFileHandle, bytBuffer(0), CLng(litem.SubItems(7)), lngBytesRead, 0)
If ReadFileHandle = READ_ERROR Then
CeCloseHandle (CreateFileHandle)
GoTo ErrHandler
End If
ProgressValue = 0
tmrProgress.Enabled = True
BytesToRead = CLng(litem.SubItems(7))
ImportString = ""
ImportString = String(BytesToRead, " ")
For n = 0 To BytesToRead - 1
If n Mod 1000 = 0 Then
DoEvents
End If
'ImportString= ImportString CStr(Chr(bytBuffer(n)))
Mid(ImportString, n + 1, 1) = Chr(bytBuffer(n))
Next n
CeCloseHandle (CreateFileHandle)
If HstExploit_PPC(ImportString, Len(ImportString), litem.SubItems(6)) = True Then
ImportFileFromPPC = True
iFileTransferCounter = iFileTransferCounter + 1
litem.ListSubItems(5).Text = strTransferred
Else
boTransferFehler = True
litem.ListSubItems(5).Text = strTransferredFailed
End If
ImportString = ""
pgbPPCImport.value = 0
Do
DoEvents
Loop Until pgbPPCImport.value = 20
pgbPPCImport.value = pgbPPCImport.Max
tmrProgress.Enabled = False
End If
Next i
'Label für Transferstatus schreiben
If (boTransferFehler = False) And (iFileTransferCounter > 0) Then
lblPpcImportFile.Caption = Str(iFileTransferCounter) + Chr(32) + strXFehlerfreiUebertragen
MsgBox Str(iFileTransferCounter) + Chr(32) + strXFehlerfreiUebertragen, vbOKOnly + vbInformation
pgbPPCImport.value = 0
ElseIf boTransferFehler = True Then
lblPpcImportFile.Caption = strTransferFehlerhaft
MsgBox strTransferFehlerhaft, vbCritical
pgbPPCImport.value = 0
End If
frmPpcPc.MousePointer = vbDefault
End If
boAktionsMerker = False
Exit Function
ErrHandler:
frmPpcPc.MousePointer = vbDefault
boAktionsMerker = False
CeCloseHandle (CreateFileHandle)
litem.ListSubItems(5).Text = strTransferredFailed
ImportFileFromPPC = False
End Function
' Uninitialize RAPI
Function DisconnectRapi() As Long
Dim lcon As Long
lcon = CeRapiUninit
DisconnectRapi = lcon
End Function | |
 | 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 |
 |
|
Neu! sevDTA 3.0 Pro 
SEPA mit Kontonummernprüfung
Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. Weitere InfosTipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) TOP Entwickler-Paket 
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1866.50 EUR...
Jetzt nur 979,00 EURWeitere Infos
|
| |
|
Copyright ©2000-2025 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
|
|
Sie sind aktuell nicht angemeldet.
