Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: ob mir hiermit nochmal jemand helfen könnte?
Autor: Martin01
Datum: 01.07.03 22:29
'PackC.cls ... Private Sub ToFileEnd() 'Zum Dateiende gehen 'evt. Err abfragen... Dim Lenght As Long Lenght = LOF(FFPack) If Lenght > 0 Then Seek FFPack, Lenght + 1 End If End Sub Private Sub ToFileAdd( _ ByVal Text As String) 'Text hinten anfügen 'evt. Err abfragen... Put FFPack, , Text End Sub Private Sub ToFileAddTFile( _ ByRef TFile As FileT) 'TFile hinten anfügen 'evt. Err abfragen... Put FFPack, , TFile End Sub Private Function ToFileAddFileText( _ ByVal FileName As String) As String 'Inhalt von FileName zurückgeben 'evt. Err abfragen... Dim ff As Integer Dim Text As String ff = FreeFile Open FileName For Binary Access Read As ff Text = Space$(LOF(ff)) Get ff, , Text CloseFF ff ToFileAddFileText = Text Text = "" End Function Private Function FromPackFile() As String 'Aktuellen Text zurückgeben 'evt. Err abfragen... Dim Text As String Text = "" Select Case ToDo Case eToDo.Yes If TFile.Lenght > 0 Then Text = Space$(TFile.Lenght) Get FFPack, , Text End If Case eToDo.No 'Text "überlesen" Seek FFPack, Seek(FFPack) + TFile.Lenght End Select FromPackFile = Text Text = "" End Function Private Function FromPackTFile() As FileT 'Dateikopf zurückgeben 'evt. Err abfragen... Get FFPack, , TFile FromPackTFile = TFile End Function Private Function FromPack2File( _ ByVal FileName As String, _ ByVal Text As String) As Long 'Inhalt zurückgeben 'evt. Err abfragen... Select Case ToDo Case eToDo.Yes If IsExitsFile(FileName) Then Kill FileName End If Dim ff As Integer ff = FreeFile Open FileName For Binary Access Write As ff Put ff, , Text CloseFF ff End Select End Function Private Sub CloseFF( _ ByRef ff As Integer) 'Datei FF schliessen If ff > 0 Then Close ff End If End Sub Private Function IsExitsFile( _ ByVal FileName) As Boolean 'Is Datei da? On Error Resume Next IsExitsFile = CBool(Len(Dir$(FileName, vbArchive Or vbHidden Or vbNormal Or vbSystem)) > 0) If Err.Number <> 0 Then Err.Clear End If On Error GoTo 0 End Function Private Function SetPath( _ ByVal Path As String) As String If Len(Path) > 1 Then If Right$(Path, 1) <> "\" Then Path = Path & "\" End If End If SetPath = Path End Function

ob mir hiermit nochmal jemand helfen könnte?	965	keeper	04.06.03 17:25
ich habe es jetzt in etwa	646	keeper	07.06.03 11:55
Re: ob mir hiermit nochmal jemand helfen könnte?	279	Martin01	13.06.03 15:34
Re: ob mir hiermit nochmal jemand helfen könnte?	736	keeper	13.06.03 15:52
Re: ob mir hiermit nochmal jemand helfen könnte?	207	Martin01	01.07.03 22:28
Re: ob mir hiermit nochmal jemand helfen könnte?	303	Martin01	01.07.03 22:29
Re: ob mir hiermit nochmal jemand helfen könnte?	252	Martin01	01.07.03 22:29
Re: ob mir hiermit nochmal jemand helfen könnte?	248	Martin01	01.07.03 22:29

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

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen