|
| |
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! sevPopUp 2.0 
Dynamische Kontextmenüs!
Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... Weitere InfosTipp des Monats Access-Tools Vol.1 
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 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
|
|
Juli 2024
Sie sind aktuell nicht angemeldet.
